diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 593406d..9c34dbc 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -10,23 +10,23 @@ jobs: ci: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@11d5960a326750d5838078e36cf38b85af677262 # v4 with: fetch-depth: 0 - - uses: actions/setup-java@v4 + - uses: actions/setup-java@cf277c60eb25467037889841efdb72551f06f6c3 # v4 with: distribution: temurin java-version: '25' - - uses: DeLaGuardo/setup-clojure@13.4 + - uses: DeLaGuardo/setup-clojure@3fe9b3ae632c6758d0b7757b0838606ef4287b08 # 13.4 with: cli: latest bb: latest clj-kondo: latest cljfmt: latest - - uses: actions/cache@v4 + - uses: actions/cache@0057852bfaa89a56745cba8c7296529d2fc39830 # v4 with: path: | ~/.m2/repository @@ -38,14 +38,22 @@ jobs: run: cljfmt check - name: Lint - run: clj-kondo --fail-level error --lint src test + run: clj-kondo --fail-level error --lint src test test-jvm + + - name: Reflection check + run: clojure -M:reflection - name: Test run: clojure -M:test - name: Test bb + # The installer is pinned to a release tag rather than master, so a push + # to that branch cannot change what this step executes. charm needs + # JLine 4.4.5, which is still only in babashka's dev builds, so the + # build it fetches is necessarily a moving target. run: | - bash <(curl https://raw.githubusercontent.com/babashka/babashka/master/install) --dev-build --dir /tmp + curl -fsSL -o /tmp/install-bb https://raw.githubusercontent.com/babashka/babashka/v1.13.223/install + bash /tmp/install-bb --dev-build --dir /tmp /tmp/bb test:bb # - name: Run vhs @@ -61,7 +69,7 @@ jobs: run: clojure -T:build jar - name: Upload artifact - uses: actions/upload-artifact@v4 + uses: actions/upload-artifact@ea165f8d65b6e75b540449e92b4886f43607fa02 # v4 with: name: charm-jar path: target/ @@ -73,20 +81,20 @@ jobs: permissions: contents: write steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@11d5960a326750d5838078e36cf38b85af677262 # v4 with: fetch-depth: 0 - - uses: actions/setup-java@v4 + - uses: actions/setup-java@cf277c60eb25467037889841efdb72551f06f6c3 # v4 with: distribution: temurin java-version: '25' - - uses: DeLaGuardo/setup-clojure@13.4 + - uses: DeLaGuardo/setup-clojure@3fe9b3ae632c6758d0b7757b0838606ef4287b08 # 13.4 with: cli: latest - - uses: actions/cache@v4 + - uses: actions/cache@0057852bfaa89a56745cba8c7296529d2fc39830 # v4 with: path: | ~/.m2/repository @@ -95,7 +103,7 @@ jobs: restore-keys: deps- - name: Restore artifact - uses: actions/download-artifact@v5 + uses: actions/download-artifact@634f93cb2916e3fdff6788551b99b062d0335ce0 # v5 with: name: charm-jar path: target/ @@ -111,5 +119,5 @@ jobs: GIT_COMMITTER_EMAIL: ${{ secrets.GIT_COMMITTER_EMAIL }} run: | git config set user.name "Timo Kramer" - git config set user.email GIT_COMMITTER_EMAIL + git config set user.email "$GIT_COMMITTER_EMAIL" clojure -T:build tag-release diff --git a/AGENTS.md b/AGENTS.md index 4e8b1a1..8d7fec2 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -17,6 +17,39 @@ With timeout (milliseconds) The REPL session persists between evaluations - namespaces and state are maintained. Always use `:reload` when requiring namespaces to pick up changes. +# API Stability + +charm.clj is a library. Its public API is used by applications we cannot see, so a +break is a cost to justify before making it, not a note to add afterwards. + +Public is every namespace whose `ns` form does *not* carry `^:no-doc`: +`charm.program`, `charm.message`, `charm.style.core`, `charm.style.border`, +`charm.style.overlay`, `charm.ansi.sanitize` and the components. Everything marked +`^:no-doc` is internal and free to change. + +- Prefer adding to the API over changing it. A new option whose default preserves + today's behaviour breaks nobody. +- A nicer design is not a serious reason. Do not change what an existing function + returns, or what an existing option means, to tidy something up. +- Serious reasons: a bug that cannot be fixed otherwise, a security problem, or a + documented feature that never worked. Say which one applies. +- Prefer a break that fails loudly over one that keeps compiling and quietly + behaves differently. +- Deprecate before deleting when it costs little. +- Record every break in `CHANGELOG.md`, marked **Potentially breaking**, and write + an ADR when the reasoning is worth keeping. + +# ADRs + +An ADR records a decision as it was made. Do not rewrite one so that it reads like +what is true now. + +- Changing `Status` is part of the lifecycle: Proposed becomes Accepted, or + Rejected or Superseded when something overtakes it. Say what overtook it. +- Anything learned after the decision goes in an appended, dated addendum, not + into the original Context or Decision. +- A decision that replaces another gets its own ADR, and the old one points to it. + # Code Style ## Keep it simple @@ -55,6 +88,8 @@ Use [Conventional Commits](https://www.conventionalcommits.org/): `type: descrip Types: `feat`, `fix`, `refactor`, `perf`, `test`, `docs`, `chore` +Never mention a plan because a plan is ephemeral and internal. Rather propose to write an ADR instead. + # Testing ## Running examples diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..22dcabb --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,236 @@ +# Changelog + +Notable changes to charm.clj, in the style of +[Keep a Changelog](https://keepachangelog.com/en/1.1.0/). + +Versions are `MAJOR.MINOR.` — the last number comes from +`git-count-revs` at release time. Releases before 0.3 are recorded only in the +[git tags](https://github.com/TimoKramer/charm.clj/tags). + +## Unreleased (0.3) + +Light/dark adaptive styling, colors written as plain values now actually apply, +a round of correctness fixes to documented features that silently did nothing, +content a program did not author no longer reaches the terminal as instructions, +and an event loop that no longer caps input at about 100 messages a second. + +### Added + +- **`merge-style`**, which returns a copy of a style with the named options + changed. `(merge base variant)` overwrites the base with the variant's + *defaults* - nil colors, false attributes - rather than inheriting them, which + is the opposite of what building a variant of a base style wants. +- **`:overflow` option on `run`**, deciding which end the renderer drops lines + from when a view is taller than the terminal. `:top` (the default, unchanged + behaviour) keeps the last lines; `:bottom` keeps the first ones, which is + usually what a full-screen program wants. +- **`:bracketed-paste` option on `run`** (default `false`). With it on, a paste + arrives as a single `:paste` message carrying the whole text, instead of one + key press per character that an application cannot tell apart from fast + typing. `msg/paste` and `msg/paste?` come with it. Off by default, because a + program that handles only key presses would otherwise stop seeing pastes. +- **`:ctrl-c` option on `run`** (default `:quit`). Ctrl+C now stops the program + before `update` sees it, so a program that does not handle it can still be + killed from the keyboard. Pass `:message` to take it over - to confirm before + quitting, say - and quitting becomes the application's job. +- **`charm.ansi.sanitize`.** `sanitize` keeps SGR styling and drops every other + escape sequence, plus every control character but newline and tab; `strip` + drops the styling too, leaving the text a terminal would display; + `strip-controls` removes control characters entirely, for strings that go + inside a sequence charm writes itself. All three return their argument + unchanged when there is nothing to remove. +- **`:sanitize` option on `run`** (default `true`), which sanitizes the view + before it is written. Set it to `false` only for a view that authors its own + control sequences. +- **Adaptive colors.** `adaptive` takes a light and a dark variant and resolves + against the terminal background at render time: + + ```clojure + (style/style :fg (style/adaptive (style/hex "#333333") + (style/hex "#dddddd"))) + ``` + +- **Terminal environment detection.** `run` detects the color profile and the + background at startup, binds both for the lifetime of the program, and sends + an `:environment` message carrying `:color-profile` and `:dark-background?`, + so applications can branch on the environment themselves. +- **`:color-profile` and `:dark-background?` options on `run`**, which pin the + environment instead of detecting it — for a terminal that misreports itself, + or a test that needs a fixed environment. Pinning `:dark-background?` also + skips the OSC 11 background query, and with it the probe timeout that a + terminal which never answers costs at every startup. +- **`charm.terminal/dark-background?`**, which queries the terminal's background + and assumes dark when the terminal does not answer. + +### Changed + +- **`charm.input.keys/key-matches?` is gone.** It duplicated `msg/key-match?`'s + pattern logic against event maps rather than messages, and had no callers. + `msg/key-match?` is the one entry point. **Potentially breaking** for anything + reaching into that internal namespace. +- **Each line is parsed once per frame.** `render!` measured a line, cut it + through a string-returning truncate, then parsed the result again - up to three + `AttributedString/fromAnsi` passes per line per frame. Measured on 40 lines of + 80 styled columns: 165 µs to 83 µs when the lines fit, 312 µs to 116 µs when + they need cutting. +- **The event loop blocks for messages instead of polling, and renders once a + frame.** It used to sleep 10 ms every iteration and then handle exactly one + message, so every keystroke waited up to 10 ms and throughput was capped near + 100 messages a second: a 300-character paste took three seconds. It now waits + on the channel, handles everything queued, and renders at most once per + `:fps`. Measured on the loop alone: 300 messages in 3 ms, 5000 in 7 ms. +- **`:fps` does something.** It was documented, stored and never read - every + single message triggered a full `view` and terminal diff. It is now the redraw + ceiling, and a burst of messages costs one frame rather than one per message. + The frame a program quits on is still drawn, so an inline program's last view + is not lost. +- **Command bodies run on virtual threads** (`a/io-thread`), not in a `go` block. + A command is where a program does its blocking work, which is exactly what a + `go` block must not do; on the eight-thread dispatch pool a handful of + concurrent commands starved it and froze the UI. Twenty commands sleeping + 100 ms each now finish in ~100 ms rather than ~300, and 2000 concurrent + commands cost no extra platform threads where a thread pool would have created + 2000 of them. Commands remain the place for blocking I/O rather than for + extended computation, which now holds a carrier thread. The color environment + still reaches command bodies, since `io-thread` conveys the binding frame too. + Where the runtime has no virtual threads - babashka's native image - it falls + back to ordinary ones. +- **`strip-ansi` strips.** It returned `AttributedString/fromAnsi`'s rendering, + which leaves a private `CSI` visible as text - `ESC[?1049h` came out as + `1049h` - and keeps carriage returns, BEL and backspace. It is now + `charm.ansi.sanitize/strip`. +- **Width measurement sanitizes first.** `string-width` and `truncate` measure + what the terminal will be given, so a sequence JLine's SGR parser mangles + rather than removes no longer throws off truncation, padding, borders, joins + and overlays. +- **`copy-to-clipboard` throws** an `ex-info` naming the size when the encoded + payload exceeds `max-clipboard-bytes` (74994, tmux's limit and the smallest + of the common ones), instead of letting the terminal truncate it silently. +- **`key-match?` accepts the short spellings** `"esc"`, `"pgup"` and `"pgdown"` + (as keywords too) for `:escape`, `:page-up` and `:page-down`. The default + page bindings in `list`, `table`, `viewport` and `paginator` now read + `"page-up"` / `"page-down"`. +- **The event loop skips the render when `update` returns the state + unchanged**, instead of re-running `view` and diffing the frame for a message + the application ignored. A resize still repaints, since the frame changed even + when the state did not. +- **Colors written as plain values now apply.** `:fg 240` (ANSI 256 code), + `:fg :red` (ANSI 16 name) and `:fg "#ff8000"` (hex string) were silently + dropped before. This also disabled the library's own default styling in + `help`, `list` and `text-input`, and most sample code. +- **Invalid color values now throw** an `ex-info` naming the value, with + `:color` in `ex-data`, instead of being ignored. This includes malformed hex + strings, so `(style/style :fg "red")` is now an error. **Potentially + breaking** for code that passed an invalid value and rendered unstyled. +- **Colors are downgraded to the terminal's profile at render time.** Under + `:ascii` color is dropped entirely. +- **Nearest-color matching is delegated to JLine's `Colors`**, which measures + distance in CIE Lab across the full 256-entry table. The previous hand-rolled + matcher searched only the color cube and the grayscale ramp, so an exact match + among the first 16 entries was unreachable — olive `(128,128,0)`, which *is* + entry 3, came back as 142 — and it quantised as though the cube levels were + evenly spaced, mapping 128 to 175 instead of 95. +- **JLine 4.3.1 → 4.4.5.** Two `ColorPalette` defects found while building the + above were fixed upstream ([#2260](https://github.com/jline/jline3/pull/2260), + [#2261](https://github.com/jline/jline3/pull/2261)). One consequence is + visible without any charm code change: output to 8- and 16-color terminals is + now downgraded as it is written, so on `TERM=xterm` a bright red `ESC[91m` + reaches the terminal as `ESC[31m`. 256-color terminals are unaffected. + +### Security + +- **Content a program did not author no longer reaches the terminal as + instructions.** The view is sanitized before it is written, so an escape + sequence in a filename or a log line is removed rather than obeyed. What + JLine 4.4.5 did not already stop, and this does: + + | injected into displayed text | before | + |---|---| + | `ESC c` | **resets the terminal** | + | `CR` | content overwrites the line it just drew, and measures wider than it displays | + | `ESC [ ?1049h` and other private CSI | rendered as the visible text `1049h`, corrupting the frame | + | C1 controls (`0x80`-`0x9f`) | passed through | + + Note for anyone reading the 0.2 threat model: on JLine 4.3.1 this list also + included OSC 52 (**writes attacker data into the system clipboard**), OSC 2 + (rewrites the window title), OSC 8 (hyperlinks the text elsewhere) and DCS. + `AttributedString/fromAnsi` drops all of those as of 4.4.5, so on this release + they were already unreachable through the render path before the sanitizer - + but not through `set-window-title`, and not for anyone pinning an older JLine. + +- **`set-window-title` escapes its argument.** Control characters are removed, + so a BEL or an ESC in the title can no longer end charm's OSC early and let + the rest of the string open one of its own - which was a clipboard write + reachable from any application that puts untrusted text in its title. + +- **Signal handlers are restored on exit.** `run` captured neither the `WINCH` + nor the `INT` handler it displaced. Both stayed installed after the program + returned, feeding a closed channel and a closed terminal - so in a REPL, which + outlives the program, Ctrl+C was swallowed for the rest of the session and a + window resize reached a terminal that was already gone. + +- **A shutdown hook restores the terminal.** `finally` does not cover + `System/exit` or `SIGTERM`, and an example in this repository exits from inside + a running program, which left raw mode on, the cursor hidden and the alternate + screen active. + +- **CI supply chain.** Actions are pinned by commit SHA rather than by tag, and + the babashka installer is fetched from a release tag rather than from `master`. + (The dev build it installs is still a moving target: charm needs JLine 4.4.5, + which babashka has only there.) + +### Fixed + +- **Styling no longer rewrites line-drawing characters as ASCII.** JLine's + `toAnsi` both emits a style's escapes and rewrites characters it assumes the + terminal cannot show, so `(style/render (style/style :border normal :border-fg + :red) "hi")` drew `+--+` while the same border unstyled drew `┌──┐`. + Compositing had it too: placing a panel over a bordered base turned the base's + `│` and `─` into `|` and `-`. +- **Component ids cannot collide.** They were `(rand-int 1000000)`, and the + spinner and timer route their tick messages back to themselves by comparing + ids, so two components sharing one drove each other. +- **`key-match?` no longer ignores modifiers when the pattern names none.** `"c"` + also fired on Ctrl+C, so an application could not bind the two to different + things. `"ctrl+c"` is unaffected, and an uppercase letter carries no shift flag + so `"G"` still matches. +- **Truncating a styled line no longer strips its styling.** `str` on an + `AttributedString` returns the plain text, so `truncate` discarded the styling + that `columnSubSequence` had just preserved - an over-long red line came back + as bare text. This affected the renderer, viewport lines, table cells and + `style/truncate` itself. The tail stays unstyled, as before. +- **A failing terminal reader no longer spins a core.** Every exception in the + input thread was caught and discarded with no backoff. It now backs off + exponentially, and after ten consecutive failures reports an error and stops + instead of looping forever. +- **Modifiers on messages built from terminal events are booleans**, not `nil`. + `key-press` documents them as `false`, and that is what they now are however + the message was built. +- **`"esc"`, `"pgup"` and `"pgdown"` never matched anything.** Key events carry + `:escape`, `:page-up` and `:page-down`, so `key-match?` compared against + `"escape"` and friends. Page Up and Page Down were dead in `list`, `table`, + `viewport` and `paginator`, and every `"esc"` binding — including the ones in + this repository's own examples and guides — silently did nothing. +- **`:strikethrough` is applied.** It was documented and used, but never reached + `AttributedStyle`. +- **`(style :padding 3)` no longer throws.** A bare number is normalized to a + box vector, as `with-padding` already did, so both entry points agree. +- **A viewport or an overflowing view no longer copies all of its content each + frame.** Both paths called `(vec lines)` on what was already a vector before + taking a `subvec`, making a viewport over a large log O(total lines) per frame + instead of O(visible). +- **Reflective calls on render paths.** Type hints in `charm.style.overlay` + (per overlay line), `charm.render.core` and `charm.input.keymap`; padding is + built with `String.repeat` rather than a seq of characters. A new + `clojure -M:reflection` check fails the build on any reflection or + auto-boxing warning under `src/`. +- **The 16-color downgrade produced arbitrary colors.** It took `(mod code 16)` + of a 256-color cube index, which is colorimetrically meaningless — orange came + out cyan. It was unreachable until profile downgrading was wired into the + render path, which would have turned every RGB color on a `TERM=xterm` + terminal into an effectively random one of 16. + +### Requirements + +JDK 22+. Ships with JLine 4.4.5, which carries the palette fixes above. +Babashka with JLine 4.4.5 (currently on master) for use with babashka. diff --git a/PLAN.md b/PLAN.md new file mode 100644 index 0000000..c101b9e --- /dev/null +++ b/PLAN.md @@ -0,0 +1,1110 @@ +# charm.clj — Improvement Plan + +Findings from a full review of `src/` (~5.5k lines), the examples, docs and CI, +plus a review of what changed in JLine since the project started (3.30.6 → +4.3.1, the current 4.x tip). Everything here was verified by running it: +benchmarks, escape-injection probes, the test suite (152 tests / 940 assertions, +all passing at time of review), and `javap` inspection of the local +`jline-terminal-4.3.1.jar`. + +Ordered by impact within each section. Each item lists the evidence, the +location, and a concrete suggestion. + +--- + +## Top priorities + +1. ~~**Background color detection / adaptive colors (J1)**~~ — **done**, together + with U1. JLine 4 exposes `getDefaultBackgroundColor()` (OSC 10/11 query); + wired up to offer light/dark-adaptive styling, with the dormant + `detect-color-profile` / `downgrade-color` code wired in alongside. +2. ~~**Sanitize untrusted content before it reaches the terminal**, and make + `strip-ansi` honest~~ — **done** (S1, S2, S3). The OSC 52 clipboard write + this was written for stopped being reachable through the render path when + Phase 0 bumped JLine to 4.4.5, whose `fromAnsi` drops OSC and DCS; what was + left, and is now fixed, is `ESC c` resetting the terminal, CR hiding content, + private CSI arriving as visible text, and the window title. See S1 for the + measurements. +3. ~~**Rewrite the event loop** to block on the channel, drain, and render once per + frame~~ — **done** (P1, P2, P3). 300 messages went from 3 s to 3 ms, and + `:fps` is now the redraw ceiling it was documented to be. +4. ~~**Fix `:fg 240`, `:strikethrough` and `"pgup"`**~~ — **done** (U1, U2, U3). + Three small bugs that made documented features, the library's own default + styling, and Page Up/Down silently do nothing. U3 turned out to cover `"esc"` + as well, which was dead in every example in the repository. + +--- + +## 1. Performance + +### P1 — Event loop caps the library at ~100 messages/second — **done** + +`src/charm/program.clj:242` + +```clojure +(when-let [_ (a/lines`; both are already vectors. + +### P8 — Input thread can busy-spin — **done** + +`src/charm/program.clj:143-146` catches and discards every exception inside +`(while @running? …)` with no backoff. A persistently failing reader pins a core +at 100%. + +**Suggestion:** count consecutive failures, back off, and bail out after a +threshold. + +**Resolved:** exponential backoff from 2 ms, capped at 500 ms, and after ten +consecutive failures the thread sends an `:error` message and stops, so the +program fails visibly instead of looping. A successful read resets the count, +which keeps the expected single failures during shutdown harmless. + +The event-to-message conversion came out of the loop into `event->msg` while +here — it was a 40-line `cond` nested five levels deep inside the thread body, +and the backoff needed another level. It is now unit-testable, which is how the +`nil`-versus-`false` modifier wart surfaced. + +### P9 — Reflection on hot paths — **done** + +- `src/charm/style/overlay.clj:48,51,57` — per line, per overlay +- `src/charm/input/keymap.clj:134` +- `src/charm/render/core.clj:199` + +Also `w/pad-right` / `w/pad-left` build padding via `(apply str (repeat n char))`, +called per line per frame throughout layout. + +**Suggestion:** add type hints; enable `*warn-on-reflection*` in the test alias so +regressions get caught. + +**Resolved:** all five sites hinted — `.append` takes `^CharSequence`, +`KeyMap.bind` resolves to the `(Object, CharSequence)` overload, and the +`ArrayList` constructor to `(Collection)`. `w/repeat-char` builds padding with +`String.repeat` and is used by `pad-right`, `pad-left` and the overlay. + +The regression guard is a `:reflection` alias rather than the test alias: +Clojure honours `*warn-on-reflection*` only while compiling, and neither +`clojure -M` nor the test runner binds it, so `dev/reflection.clj` loads every +namespace under `src/` with the flag on and exits non-zero if anything warned. +It is wired into `bb ci` and the workflow. Since it captures `*err*` wholesale +it also catches auto-boxing warnings, which turned up three `recur` args in +`charm.ansi.parser`, `charm.style.border` and `charm.components.help`; those are +coerced with `long`. + +--- + +## 2. Security + +The threat model that matters here is *a TUI rendering data its user didn't +author* — filenames, log lines, HTTP responses. That is precisely what the +file-browser and download examples do. + +### S1 — Untrusted content reaches the terminal as OSC and DCS escapes — **done** + +Verified end to end: these survive both `strip-ansi` and the +`AttributedString/fromAnsi` render path unchanged. + +| injected into displayed text | result | +|---|---| +| `ESC ] 52 ; c ; BEL` | **writes attacker data into the user's system clipboard** (iTerm2, kitty, foot, wezterm, tmux with `set-clipboard`) | +| `ESC ] 2 ; … BEL` | rewrites the terminal window/tab title | +| `ESC ] 8 ; ; BEL` | injects a hyperlink — visible text says one thing, the link goes elsewhere | +| `ESC P … ESC \` (DCS) | passes through untouched | +| `ESC [ 2K CR` | erases the line and rewrites it — content can hide what it just displayed | + +Highest-severity item. `AttributedString/fromAnsi` is an SGR parser, not a +sanitizer, and it is currently the only thing between untrusted input and the +terminal. + +**Suggestion:** add `charm.ansi/sanitize` that keeps SGR and drops +OSC/DCS/APC/PM/SOS, C1, and C0 other than `\n` / `\t`. Apply it in `render!` by +default, with an opt-out for content the app authored itself. + +**Resolved, and the table above is out of date — half of it was fixed by the +JLine bump in Phase 0, not by this.** + +`charm.ansi.sanitize/sanitize` does what the suggestion says, `strip` also drops +SGR, and `strip-controls` drops control characters outright for strings that go +inside a sequence charm writes itself. `render!` applies `sanitize` unless the +renderer was built with `:sanitize false`, which `run` exposes as an option. A +single scan, and the argument is returned unchanged when nothing was removed, so +plain and already-styled text cost no allocation. + +**The premise that needs recording:** the table was measured against JLine +4.3.1. Phase 0 moved to 4.4.5 for the `ColorPalette` fixes, and 4.4.5's +`AttributedString/fromAnsi` drops OSC, DCS and standard CSI. Verified by running +the same probes under both versions: + +| injected | 4.3.1 `fromAnsi` | 4.4.5 `fromAnsi` | +|---|---|---| +| `ESC ] 52 ; c ; BEL` | passes through, width 20 | dropped, width 8 | +| `ESC ] 2 ; … BEL` | passes through | dropped | +| `ESC P … ESC \` (DCS) | passes through | dropped | +| `ESC [ 10;10 H` | dropped | dropped | + +So on the version charm now ships, the clipboard write was already unreachable +through `render!` before this change. It was **not** unreachable through +`set-window-title` (S4), and it stays reachable for anyone pinning an older +JLine. + +What 4.4.5 still lets through, which is what the sanitizer is actually buying: + +| injected | 4.4.5 `fromAnsi` result | +|---|---| +| `ESC c` (RIS) | **passes through — resets the terminal** | +| `CR` | passes through; `visible ESC[2K CR hidden` measures 12 for 6 cells | +| `BEL`, backspace | pass through | +| `ESC [ ?1049h` (private CSI) | **mangled into the visible text `1049h`**, width 5 | +| C1 `0x80`-`0x9f` | pass through | + +The first is a live terminal-reset vector, the second and fourth are content +hiding plus a wrong width for everything downstream. + +### S2 — `strip-ansi` doesn't strip — **done** + +`src/charm/ansi/width.clj:13`. It is the function anyone displaying untrusted +data will reach for, and it leaves everything in S1 intact. It also *mangles* +private CSI rather than removing it: `ESC [ ?1049h` comes out as the visible +text `1049h`. + +**Suggestion:** make it exhaustive as part of S1. + +**Resolved:** it is `sanitize/strip`. The `ESC [ ?1049h` → `1049h` mangling was +still there on 4.4.5, so this half of S2 was real as written. + +### S3 — Width measurement is wrong for unrecognised escapes — **done** + +`"file" ESC "]2;PWNED" BEL ".txt"` measures **14** but displays **8**. Every +downstream decision — truncate, pad, border, join, overlay — is then computed +from a wrong number, so injected content also breaks the frame. + +**Suggestion:** falls out of S1 once sanitisation happens before measurement. + +**Resolved, but not by itself** — sanitising in `render!` is too late, because +every layout decision is made above it. `string-width` and `truncate` sanitize +their argument first instead. + +The example in the heading no longer reproduces on 4.4.5 (`fromAnsi` measures +that OSC as 8), but `visible ESC[2K CR hidden` still measured 12 for 6 cells and +`ESC[?1049h` still measured 5 for 0, so the class of bug was intact. + +### S4 — `set-window-title` doesn't escape its argument — **done** + +`src/charm/render/screen.clj:52`. A BEL or ESC in the title terminates the OSC +early and lets the caller's string open a new one. Verified: title +`"hi" ESC "]52;c;ZXZpbA=="` emits two OSCs, the second a clipboard write. + +`copy-to-clipboard` (`src/charm/render/screen.clj:59`) is likewise unbounded — +terminals cap OSC 52 payloads and truncate silently. + +**Suggestion:** strip control characters from the title; document and enforce a +size cap on the clipboard payload. + +**Resolved:** the title goes through `sanitize/strip-controls`, so it cannot end +charm's OSC or open one of its own. This was the one place where the OSC 52 +clipboard write stayed reachable on 4.4.5, since it does not go through +`fromAnsi`. `copy-to-clipboard` throws an `ex-info` naming the size above +`max-clipboard-bytes` (74994, tmux's limit and the smallest of the common ones). + +### S5 — Signal handlers are registered and never restored — **done** + +`src/charm/program.clj:228,233`. `run`'s `finally` restores terminal attributes +but not the WINCH/INT handlers. `Signals/register` returns the previous handler; +nothing captures it. + +In a REPL — which the README actively promotes — Ctrl+C stays hijacked after a +program exits, feeding a closure that puts into a closed channel, so SIGINT is +silently swallowed for the rest of the session. + +**Suggestion:** capture the return value of `Signals/register` and restore it in +the `finally`. + +**Resolved, but not via J6** — see J6 for why `Terminal.handle` could not be +used. `charm.terminal/handle-signal` and `restore-signal!` wrap +`Signals/register` / `Signals/unregister`, `run` keeps what it displaced and puts +it back in the `finally`, before the terminal closes under it. + +Verified against a real program: install a marker handler, displace it once to +learn the native handler object JLine wrapped it in, run a program to completion, +and check that object is the one installed afterwards. Note that +`Signals/register` returns JLine's *native* handler, not the `Runnable` handed +to it, so comparing against the `Runnable` reports a false failure. + +### S6 — No shutdown hook — **done** + +`finally` covers exceptions but not `System/exit` or SIGTERM. The terminal is +left in raw mode, cursor hidden, alt-screen active. +`doc/examples/src/examples/timer.clj:198` calls `System/exit 1` from inside a +running program, so this is reachable from the repo's own code. + +**Suggestion:** register a shutdown hook that restores attributes, shows the +cursor and exits the alt screen. + +**Resolved:** `run` registers one and removes it again in the `finally`, so +repeated runs do not accumulate hooks. Both it and the `finally` call the same +`restore-terminal!`, which tolerates running twice and after the terminal is +gone. Verified by reproducing the `System/exit` path from +`examples/timer.clj:198`: the restore sequences are emitted and the exit code +survives. + +`restore-terminal!` is also two lines shorter than the cleanup it replaced: +`render/stop!` already disables the mouse, focus reporting, shows the cursor and +leaves the alternate screen, so the `finally`'s own `disable-mouse!` and +`disable-focus-reporting!` were emitting every sequence twice. + +### S7 — CI supply chain — **mostly done** + +`.github/workflows/ci.yml`: + +- `bash <(curl https://raw.githubusercontent.com/babashka/babashka/master/install)` + executes an unpinned script from a moving branch. +- Actions are pinned by tag, not commit SHA — including third-party + `DeLaGuardo/setup-clojure@13.4`. +- The `release` job holds `CLOJARS_PASSWORD` with `contents: write` and fires on + every push to `main`. +- `git config set user.email GIT_COMMITTER_EMAIL` is missing a `$` — it sets the + literal string, not the secret. + +**Suggestion:** pin actions by SHA, pin the babashka installer to a tag, and fix +the `$`. Consider gating release on a tag rather than every push to `main`. + +**Resolved, except the release gate.** The `$` was fixed in Phase 1. All six +actions are now pinned by commit SHA with the tag in a trailing comment, and the +babashka installer is fetched from the `v1.13.223` tag rather than from `master`. +The dev build that installer then downloads is still a moving target, which is +unavoidable while charm needs JLine 4.4.5 and babashka carries it only there. + +**Still open:** the `release` job holds `CLOJARS_PASSWORD` with `contents: write` +and fires on every push to `main`. Gating it on a tag changes how releases are +cut, so it is the maintainer's call rather than a mechanical fix. + +--- + +## 3. Usability + +### U1 — `:fg 240` silently does nothing — **done** + +`doc/api/styling.md:198` documents it as "ANSI 256 shorthand", but +`src/charm/style/color.clj:118` dispatches on `(:type color)`, which is `nil` for +an integer, and returns the style unchanged. Verified: +`(style/render (style/style :fg 240) "hi")` → `"hi"`, no escapes. + +Used in the library's own defaults — `src/charm/components/text_input.clj:97` +(placeholder) and `src/charm/components/list.clj:305` (item descriptions) — and +in ~15 places across docs and examples. So a documented feature, the library's +default styling, and most of the sample code all render as plain text. + +**Suggestion:** coerce integers and keywords to colour maps in `style` / +`with-fg` / `with-bg`, or throw on an unrecognised colour value. + +**Resolved:** `charm.style.color/coerce-color` accepts integers (ANSI 256), +keywords (ANSI 16 names) and strings (hex), and throws an `ex-info` naming the +offending value otherwise. Coercion happens in `apply-color-fg` / `apply-color-bg` +rather than in each constructor, so every entry point — `style`, `with-fg`, +`with-bg`, `styled-str` — picks it up at once. + +### U2 — `:strikethrough` silently does nothing — **done** + +Documented in the `doc/api/styling.md:32` options table, used in +`doc/examples/src/examples/todos.clj:20`, never applied by +`style->attributed-style` (`src/charm/style/core.clj:143`). + +**Suggestion:** add it to the `cond->`, and audit the docs table against that +function for anything else missing. + +**Resolved:** added as `.crossedOut`, plus `:strikethrough false` in the `style` +constructor's defaults. The audit found nothing else missing — the docs table +and the `cond->` now agree, and a test walks every documented attribute and +asserts its SGR code reaches the output. + +### U3 — `"pgup"` / `"pgdown"` never match — Page Up/Down is dead in four components — **done** + +Key events carry `:key :page-up`; `key-match?` compares against +`(name :page-up)` = `"page-up"`. Verified: +`(msg/key-match? (msg/key-press :page-up) "pgup")` → `false`. + +Affects `src/charm/components/viewport.clj:29-30`, +`src/charm/components/list.clj:24-25`, +`src/charm/components/table.clj:28-29`, +`src/charm/components/paginator.clj:20-21`. + +**Suggestion:** rename the bindings to `"page-up"` / `"page-down"`, or accept +aliases in `key-match?`. Add a test that asserts every default binding string in +every component resolves against a real key event — this class of bug is +otherwise invisible. + +**Resolved:** both. The component defaults were renamed to `"page-up"` / +`"page-down"`, and `key-match?` gained a small alias table, because the same bug +covered **`"esc"`**, which is used in ten of this repository's own examples and +guides plus the `doc/api/messages.md` table — so escape handling was dead +throughout the sample code, not just Page Up and Page Down. + +The guard is `test/charm/components/keybindings_test.clj`. Rather than encode a +naming convention, it generates one key-press message for every key a real event +can carry (`keys/key-types` plus printable runes, across all eight modifier +combinations) and asserts that each default binding in every component matches at +least one of them — i.e. that some real keystroke can reach it. + +`key-match?` was also simplified while there: its keyword and string branches +were the same comparison written twice, and the modifier branch's +`(= key-part (str msg-key))` fallback was unreachable, since `:key` is always +either a string or a keyword. + +One thing found here and deliberately left alone, now U12 below. + +### U4 — `(style :padding 3)` throws — **done** + +`render` passes the raw value to `expand-box-values` → +`UnsupportedOperationException: count not supported on this type: Long`. +`with-padding` normalizes a bare number; the `style` constructor doesn't, so the +two entry points disagree. + +`hex` (`src/charm/style/color.clj:96`) likewise throws a raw +`NumberFormatException` on bad input rather than an `ex-info`. + +**Suggestion:** normalize in `style`, and wrap `hex` parse failures in `ex-info` +with the offending string. + +**Resolved:** the normalization `with-padding` did inline moved to +`layout/normalize-box`, which `style`, `with-padding` and `with-margin` all use, +so the stored value is a vector whichever entry point built it. The `hex` half +landed with U1. + +### U12 — `key-match?` ignores modifiers unless the pattern names one — **done** + +`(msg/key-match? (msg/key-press "c" :ctrl true) "c")` is `true`: only the +`"ctrl+x"` branch looks at `:ctrl` / `:alt` / `:shift`, so a plain `"c"` binding +also fires on Ctrl+C. Found while fixing U3 and left alone there, because it +changes matching semantics for every existing binding rather than adding a +missing name. + +**Suggestion:** require the message's modifiers to be unset when the pattern +names none, and check the repo's own bindings for anything that was relying on +the loose match. + +**Resolved:** a bare name now requires the modifiers to be unset. Checked before +changing it: every component default binding still fires, and uppercase letters +arrive as runes with no shift flag, so `"G"` still matches. + +### U5 — Bracketed paste is built but never wired up — **done** + +`src/charm/render/core.clj:146-154` has the enable/disable calls and +`src/charm/input/keymap.clj:79-80` binds `:paste-start` / `:paste-end` — but +`run` has no option and never enables it. So pastes arrive as individual +keystrokes (throttled to 100/s by P1), and the markers are indistinguishable +from typed input. + +**Suggestion:** add a `:bracketed-paste` option, enable it in `start!`, and +coalesce everything between the markers into a single paste message. + +**Resolved** as suggested, plus `msg/paste` / `msg/paste?`, and `stop!` disables +it again. Default `false`: turning it on changes what an application receives, and +one that only handles key presses would stop seeing pastes altogether. + +Inside a paste, Enter and Tab are appended as text rather than delivered as key +presses, and an event that cannot be part of the text is dropped without ending +the paste early. + +**A bound was needed that the suggestion did not mention.** Waiting for the end +marker with no limit means a truncated paste sequence keeps the input thread in +that loop forever, and the application stops seeing input at all — a freeze, not +a slow path. Found by an integration test for the unterminated case hanging the +suite. Three consecutive read timeouts (~300 ms of silence) now end the paste; a +paste arrives as one contiguous burst, so silence means the terminal is not going +to finish it. + +### U6 — Ctrl+C is intercepted and turned into a key message — **done** + +`src/charm/program.clj:233`. If the app's `update` doesn't handle `"ctrl+c"`, the +program cannot be killed from the keyboard. + +**Suggestion:** make it an option, default to quitting unless the app opts in, +and document it prominently either way. + +**Resolved:** `:ctrl-c` is `:quit` by default, which stops the program before +`update` sees the key, or `:message`, which delivers it as an ordinary +`"ctrl+c"` key press and leaves quitting to the application. Documented in +`doc/api/program.md` under its own heading and in the README's option list. + +Verified against a program whose `update` handles nothing at all: it now exits on +Ctrl+C, where before it could not be killed from the keyboard. Every one of the +fourteen examples in this repository uses `"ctrl+c"` only to quit, so the new +default is behaviour-preserving for all of them and their bindings simply became +redundant. + +### U7 — Overflowing views are truncated from the top — **done** + +`src/charm/render/core.clj:184` keeps the *last* `height` lines. Sensible inline; +surprising full-screen, where a view one line too tall silently loses its title. + +**Suggestion:** document it, and make the direction configurable. + +**Resolved:** `:overflow` on `run`, `:top` (unchanged default) or `:bottom`, +documented in `doc/api/program.md` with why a full-screen program usually wants +the other one. + +### U8 — Component IDs are `(rand-int 1000000)` — **done** + +`src/charm/components/list.clj:88`, `src/charm/components/text_input.clj:79`, +`src/charm/components/viewport.clj:66`. ~1% collision chance at 150 components, +and it makes component state non-reproducible in tests. + +**Suggestion:** a counter or `gensym`. + +**Resolved:** a counter in `charm.components.id`. Worth noting the collision was +not cosmetic - the spinner and timer compare ids to route their own tick +messages, so a collision made two of them drive each other. + +### U9 — Two overlapping key-matching APIs — **done** + +`msg/key-match?` and `keys/key-matches?`, with different pattern semantics +operating on different data shapes (message vs. event map). + +**Suggestion:** collapse to one; keep `msg/key-match?` as the public entry point. + +**Resolved:** `keys/key-matches?` deleted. It had no callers outside its own +tests, and its pattern branch was the same modifier logic as `msg/key-match?`'s. + +### U10 — `style` returns all 17 keys defaulted — **done** + +So `merge`ing a variant onto a base overwrites with `nil` / `false` instead of +inheriting. There is no `merge-style` / `inherit`, which is the first thing +anyone building a theme reaches for. + +**Suggestion:** add `merge-style` that ignores unset keys, or stop defaulting +every key in the constructor. + +**Resolved:** `merge-style` takes named options rather than a second style map, +which sidesteps the question of which keys were 'unset' - `(merge-style s :bold +false)` genuinely turns bold off. The constructor still defaults every key; +nothing needed to change there. + +### U11 — Nothing auto-sizes to the terminal — **done as documentation** + +Every component takes `:height 0` = unbounded, so each app hand-threads +window-size arithmetic. `doc/examples/src/examples/file_browser.clj:85-93` spends +real code on `chrome-height` bookkeeping. + +**Suggestion:** a "fill remaining space" affordance would remove a lot of +per-app boilerplate. + +**Resolved without new API, because there was no missing capability.** Two things +the item conflates: + +*Resize already works.* `:window-size` arrives at startup and on every WINCH, the +renderer resizes itself and the message reaches `update`, which rebuilds its +components. Four examples already do this. Nothing was missing in the plumbing. + +*The remaining rows are already computable.* An application can measure the rest +of its view — `(count (re-seq #"\n" header))` — and hand the remainder to the +component. `file_browser` simply did not: it kept `chrome-height 5` where the view +uses 4, which cost a row of listing on every terminal, and the comment above the +constant counted a blank line the view never emitted. + +So: the example now derives it from the very `header` and `footer` functions the +view renders, and `doc/api/program.md` documents the pattern. Measured before and +after, view rows against terminal rows: 22/24 and 28/30 before, 24/24 and 30/30 +after. At an odd height it is still one short, because each list item is two rows. + +**What would justify real API**, and did not turn up here: a view whose chrome +height depends on the body's height. That is circular, so no amount of measuring +resolves it, and it is the case a layout container would exist for. Written up as +[issue #19](https://github.com/TimoKramer/charm.clj/issues/19), with the shape, the +algorithm, the constraints that came out of ADR 008 and the sanitiser work, and the +open design questions — so it does not have to be rediscovered. + +--- + +## 4. JLine 4.x adoption + +The project started on JLine 3.30.6 (2026-01), moved to 4.0.10/4.0.12 (April — +the Mode 2027 grapheme work, ADR 007), and sits on 4.3.1 (July) — verified to be +the current tip of the 4.x line (3.30.16 is a maintenance backport on the old +branch). So the version is current; these items are 4.x capabilities the +library doesn't use yet, plus behavior changes to be aware of. + +Already absorbed: Mode 2027 grapheme clustering (ADR 007), the 4.3.1 ReDoS +guards, 4.1's `Display.update()` optimizations, and the shift+tab CSI Z binding +(done in-repo, `aa6a75e` — JLine still doesn't bind it). + +### J1 — Background color detection / adaptive colors — **done** + +JLine 4 can query the terminal's actual default colors (OSC 10/11): + +```java +terminal.getDefaultBackgroundColor() ; -> int RGB, or -1 if unknown +terminal.getDefaultForegroundColor() +terminal.getPalette() ; -> ColorPalette +``` + +This is the primitive lipgloss uses for `HasDarkBackground` — light/dark +adaptive styling is one of the most-requested TUI features and charm.clj +currently has no way to do it. + +Related dormant code: `charm.style.color` already contains +`detect-color-profile` and `downgrade-color`, and **nothing calls either** +(verified by grep). JLine 4 also detects true-color from `COLORTERM` natively. + +**Suggestion:** +- Add `charm.terminal/dark-background?` (query `getDefaultBackgroundColor`, + compute luminance, sensible default when the query returns -1). +- Add an adaptive color type: `{:type :adaptive :light :dark }`, + resolved at render time against the detected background. +- Wire `detect-color-profile` + `downgrade-color` into the render path (or + delegate profile detection to JLine's `ColorPalette`) so ANSI-only terminals + degrade instead of getting raw true-color escapes. +- Expose the resolved profile/background on the program state (e.g. an + `:environment` msg at startup) so apps can branch on it. +- Note the interaction with U1: fixing integer-color coercion first avoids + building adaptive colors on top of a constructor that silently drops ints. + +**Resolved:** + +- `charm.terminal/dark-background?` queries `getDefaultBackgroundColor`, computes + luminance via `dark-color?`, and defaults to dark when the query returns -1. +- Adaptive colors are `{:type :adaptive :light … :dark …}`, built with + `style/adaptive` and resolved at render time by `color/resolve-color`. +- `run` detects profile and background once at startup, binds + `*color-profile*` / `*dark-background?*` around the event loop, and sends an + `:environment` message so apps can branch themselves. +- `:color-profile` and `:dark-background?` are `run` options; `nil` (the + default) detects. Pinning `:dark-background?` also skips the OSC 11 query and + its probe timeout. An unknown profile throws rather than silently passing + through `downgrade-color`'s `case` default. +- Documented in `doc/api/styling.md` (adaptive colors, profile table, pinning), + `doc/api/program.md` (both options) and `doc/api/messages.md` + (`:environment`). + +**Three premises above turned out to be wrong, and are worth recording:** + +1. *"ANSI-only terminals get raw true-color escapes."* They never did — and + neither does anything else. `AttributedString.toAnsi()` called without a + terminal argument collapses 24-bit colors to the 256 palette, so charm has + never emitted a `38;2;r;g;b` sequence: `(rgb 255 0 0)` renders as + `ESC[38;5;196m` even under the `:true-color` profile, and the existing tests + in `test/charm/style/color_test.clj` assert exactly that. Making true color + actually reach the terminal is a separate change — it needs the `toAnsi` + overload that takes a terminal — and it belongs with the Phase 4 render work, + since it changes those assertions. + +2. *`downgrade-color` was dormant but also wrong.* Its `:ansi` branch did + `(mod code 16)` on a 256-cube index, which is colorimetrically meaningless: + orange `(rgb 255 128 0)` came out **cyan**. Harmless while nothing called it, + but wiring it in would have turned every RGB color on a `TERM=xterm` terminal + into an effectively random one of 16 — worse than the previous + pass-everything-through behavior. + + It was first replaced with a hand-rolled nearest-neighbour match, which was + the wrong instinct — see premise 3. + +3. *All of the color conversion was JLine's already, and our copies were worse.* + `org.jline.utils.Colors` offers `rgbColor(int)` (palette index → RGB), + `roundColor(idx, max)` and `roundRgbColor(r, g, b, max)`, matching in CIE Lab + via `Colors$Distance`, over `DEFAULT_COLORS_256`. Measured against it: + + - `ansi256->rgb` was identical to `Colors/rgbColor` on every probe — pure + duplication. + - `rgb->ansi16` agreed on 5 of 6 probes; ours measured distance in RGB space. + - `rgb->ansi256` was **strictly worse in 73 of 125 probes**, for two reasons: + it only searched the 16–231 cube and the 232–255 ramp, so exact matches in + the first 16 entries were missed (olive `(128,128,0)` *is* entry 3; we + returned 142), and it quantised as `(v*5/255)` as if the cube levels were + evenly spaced when they are 0/95/135/175/215/255, so 128 became 175 rather + than 95. + + Worse, wiring `downgrade-color` into `apply-color-fg` *took this job away + from JLine*, which had been doing it correctly all along: before the wiring, + `apply-color-fg` passed raw RGB to `.foreground` and JLine's `toAnsi` chose + 208 for orange; after it, our matcher chose 214 and JLine merely printed it. + + `downgrade-color` now delegates to `Colors`, and the three conversion + functions plus `ansi-hex` and `cube-levels` are deleted. The `:ansi` profile + keeps the one thing the wiring genuinely gained — basic SGR codes + (`ESC[91m`) instead of a 256-color code, which no-terminal `toAnsi` will not + emit. + + Still ours, because JLine has no equivalent: `coerce-color` (ints, keywords, + hex) and `adaptive`. Also still ours, but duplicating terminfo `max_colors`: + `detect-color-profile`. + +**The dynamic vars are the interim mechanism, and Phase 4 retires them.** + +`resolve-color` needs the profile four frames below anything that was handed the +state: + +``` +(view state) → (list-view (:list state)) → (style/render item-style title) → resolve-color +``` + +`style/render` returns a finished `String` with escapes already in it, so the +"is this terminal true-color?" decision is made down there, in a function whose +signature is `(style & strings)`. Dynamic vars are the standard answer to that, +and the alternative — threading an environment argument through every +`xxx-view` — is viral across the whole component API. + +The exit is [ADR 008](adr/008-styling-currency.md): `style/render` builds styled +*data*, and the renderer, which already holds the terminal, resolves colors when +it emits. +No ambient value, no threading. That is the same change premise 1 above needs — +real `38;2;r;g;b` output requires the `toAnsi` overload that takes a `Terminal`, +which only the renderer has — so the two should land together. It breaks user +code that concatenates styled strings (`(str (style/render …) "more")`), which +is why it belongs with the Phase 4 render work and not here. + +Two smaller things deliberately left alone until then, both invisible today: + +1. `init` is called in `run`'s `let`, before the `binding` opens, so styling + done at init time resolves against the root values. No component's `init` + styles anything, so only user code that pre-renders styled strings in its + own `init` can reach it. +2. The vars are thread-local. core.async's `go` conveys the binding frame, so + commands are fine; a `view` that renders parts on app-owned threads or + futures is not. + +Both disappear with the renderer-owned environment, so fixing them now would be +wasted work. + +### J2 — `KeyEvent` / `KeyParser`: revisit ADR 004 — **spiked, not adopted** + +`org.jline.terminal.KeyParser/parse` (static, non-blocking — none of ADR 004's +BindingReader objections apply) returns a structured `KeyEvent`: type +(Character/Arrow/Function/Special/Unknown), `EnumSet` of Shift/Alt/Control, +raw sequence. This API did not exist when ADR 004 was written and overlaps +heavily with the ~500 hand-rolled lines in `charm.input.keys` + +`charm.input.keymap` (including the generated xterm modifier table). + +**Suggestion:** spike — run the corpus from `test/charm/input/keys_test.clj` +through `KeyParser.parse` and diff coverage. If it covers the table, delete +code; if not, document the gap in ADR 004 and keep the keymap. + +**Done, and the keymap stays.** The corpus came from the keymap's own tables +rather than the test file, so it covers all 259 sequences charm binds including the +generated modifier combinations: 209 agree, **0 disagree**, 50 cannot be parsed. + +Three independent reasons not to adopt it, any one of which would be enough: the +50 gaps include focus reporting, bracketed paste, the SS3 arrows and F13–F20, all +of which charm supports today; `KeyParser` is hardcoded where `KeyMap` binds from +terminfo; and neither `KeyParser` nor `KeyEvent` is in babashka's image, while +`KeyMap` is. Input is core, so there is no `test-jvm`-style exclusion available. + +Written up as a dated addendum to [ADR 004](adr/004-jline-input-api-choices.md), +which it confirms rather than revises. + +The zero disagreements are worth more than the decision: they independently +validate a table charm generates itself. `charm.input.keyparser-test` now keeps +that check standing, and fails if JLine closes one of the gaps — which is the +signal to revisit. + +### J3 — `ScreenTerminal` for integration tests — **done** + +`org.jline.utils.ScreenTerminal` (consolidated 4.2, scrollback + cell decoding +exposed 4.3.0) is a full in-memory VT emulator: `write` the renderer's output, +then assert on the resulting screen grid via `dump` / `getHistory` and per-cell +accessors (`cellCodePoint`, `cellBold`, `cellFg`, …). + +The current integration-test pattern (ADR 003: dumb terminal + +`ByteArrayOutputStream`) asserts on raw escape bytes, which breaks whenever +`Display`'s diffing strategy changes even though the screen is identical. +Asserting on final screen cells tests what the user actually sees, and could +absorb some VHS visual tests without the ffmpeg/ttyd CI machinery (currently +commented out in `ci.yml`). + +**Suggestion:** add a test helper that renders a frame into a `ScreenTerminal` +and returns the grid; migrate the brittle byte-level assertions; update ADR 003. + +**Resolved:** `charm.test.screen` plus 25 assertions in +`charm.integration.screen-test`. ADR 003 gained a dated addendum rather than an +edit, since it records a decision already made. + +Two things the item did not mention. The size has to be given to the +`TerminalBuilder` as well as the renderer: `Display` takes its width from the +terminal, and one that thinks the screen is wider pads with a cursor-forward, +which lands the next line a column over. And the cell accessors are *static* +methods on `ScreenTerminal`, not instance ones. `render-to-bytes` had the same +sizing mistake, which its substring assertions hid. + +The byte-level tests were kept rather than migrated wholesale: "this OSC never +reached the terminal" is a statement about the wire, not the screen, and that is +where the sanitiser's guarantees live. + +**These tests cannot run under babashka.** `ScreenTerminal` is not in its image, +and a namespace naming it fails to load at analysis time, so they live in +`test-jvm/`, which `deps.edn` lists and `bb.edn` does not. The ask to babashka is +small if it is ever worth making - the class has no dependencies outside the JDK +and three JLine classes already in the image, and needs no `reify`, unlike J6. + +### J4 — `Terminal.trackMouse` now covers SGR + +`MouseSupport` in 4.3.1 emits `?1005/?1006/?1015` (verified in the jar), so +ADR 004's era gap is closed. `trackMouse(MouseTracking/{Off,Normal,Button,Any})` +maps 1:1 onto charm's `nil/:normal/:cell/:all` and could replace the raw escape +writes in `src/charm/render/core.clj:96-120`; `readMouseEvent(String)` accepts +the already-read prefix, addressing the "detect the prefix first" objection. +JLine then also cleans up mouse state on `close()`. + +**Suggestion:** replace enable/disable with `trackMouse`; keep the custom SGR +*parsing* (it works and is tested). + +### J5 — Terminal graphics: images (Kitty / iTerm2 / Sixel) + +4.0 added `TerminalGraphicsManager` with runtime protocol detection and +one-call display (`isGraphicsSupported`, `displayImage(terminal, file)`). +A genuine feature opportunity — image support Bubble Tea core doesn't have. + +Caveats: lives in the `impl` package (weaker stability guarantees) and depends +on `java.awt.BufferedImage` — expect unavailable on babashka and extra config +for native-image (`isJavaDesktopAvailable` guard exists for graceful +degradation). + +**Suggestion:** optional `charm.components.image` guarded by +`isGraphicsSupported`; document the platform matrix. + +### J6 — Signal handling: migrate to `Terminal.handle` — **blocked** + +JLine 4 modernized signals (4.1 FFM `sigaction`, 4.2 ISIG restoration, 4.3 +PosixSysTerminal interception). charm uses the static +`org.jline.utils.Signals/register` (`src/charm/program.clj:228,233`); +`Terminal.handle(Signal, SignalHandler)` is the supported route **and returns +the previous handler** — exactly what S5 needs to restore Ctrl+C after exit. + +**Suggestion:** fix S5 by migrating to `Terminal.handle`, one change for both. + +**Not done — blocked on babashka, and the blocker is `reify`, not the class.** +The migration was written and reverted: it fails to load under `bb test:bb`, a +platform this project supports and tests in CI. Diagnosed precisely afterwards, +because the first read of the error was misleading: + +| in babashka | result | +|---|---| +| `Class/forName` on `Terminal$Signal`, `Terminal$SignalHandler`, `Terminal$MouseTracking`, `MouseEvent` | all resolve — the classes are in the image | +| `Terminal$Signal` as a *symbol* (`:import`, static field access) | not exposed to SCI | +| `Terminal$SignalHandler` as a symbol | **exposed** | +| `(.getEnumConstants Terminal$Signal)` via `Class/forName` | works — enum values are reachable | +| `(.getField signal-class "WINCH")` | fails, not registered for reflection | +| `reify Terminal$SignalHandler` | **`Unsupported interface in reify`** | +| `java.lang.reflect.Proxy` | not exposed | + +So the handler interface cannot be implemented in babashka at all: `reify` works +only for the interfaces on babashka's own list (`Runnable`, `Comparator`, +`Map$Entry` and the like), and there is no `Proxy` to fall back on. Exposing +`Terminal$Signal` would not be enough; babashka would have to add a third-party +callback interface to its reify registry, which is a larger ask than exposing a +class, and would then put a floor on the babashka version charm supports. + +S5 was fixed with the static `Signals` helper instead — it returns the previous +handler just as `Terminal.handle` does, and `reify Runnable` is on babashka's +list. Nothing was lost but the supported-API argument. + +Worth revisiting when there is a reason beyond tidiness. The candidates: +`Signals` installs handlers process-globally where `Terminal.handle` is +per-terminal (latent, since the handlers are now restored); JLine's newer signal +work — 4.1's FFM `sigaction`, 4.2's ISIG restoration, 4.3's `PosixSysTerminal` +interception — lands on `Terminal.handle` and not on `Signals`, and charm runs in +raw mode, where ISIG behavior matters; and `Signals` reflects on +`sun.misc.Signal`, which needs GraalVM reflection config (untested against the +native-image config under `doc/examples/`). + +**Note for J4:** `trackMouse` takes the `Terminal$MouseTracking` *enum*, not a +callback, and `.getEnumConstants` does work in babashka — so J4 does not need +anything from babashka, unlike this. + +### J7 — Behavior changes to be aware of + +- **Terminals throw when used after close** (4.0 breaking change; 3.x was + silent). `run`'s cleanup ordering is fine, but `run-async`'s `:quit!` racing + a late `render!` against `term/close` would now throw. Audit alongside S5/S6. + + **Audited.** `run-async`'s `:quit!` only flips the `running?` atom; the loop + notices, finishes its iteration and then does its own cleanup, all on the + program's thread, so there is no external `render!` to race. The real exposure + was the WINCH handler, which outlived the program and called `get-size` on a + closed terminal — that is S5, now fixed. What remains is the input thread, + which can touch the reader after `term/close`; it catches `Exception` broadly + and is a daemon, so it exits quietly. P8 (backoff) is where that gets tidied. +- 4.1.2/4.1.3 fixed alt-screen cursor positioning and raw-mode ISIG behavior — + any local workarounds can be removed. +- New sibling modules `jline-prompt` / `jline-components` / `jline-shell` (4.0): + JLine growing its own UI story. Nothing to adopt, worth watching as + overlapping ecosystem. +- **Kitty keyboard protocol (CSI u): not in JLine** as of 4.3.1 — the xterm + modifier table in `keymap.clj` remains necessary; disambiguated keys + (Shift+Enter etc.) would need an in-repo implementation. + +--- + +## Suggested sequencing + +**Phase 0 — background color detection (J1)** — **done** +U1 (integer-color coercion) landed as its opening step, so adaptive colors +aren't built on a constructor that silently drops ints. Also fixed +`downgrade-color`'s nearest-ANSI-16 mapping, which the wiring made reachable, +and added the `:color-profile` / `:dark-background?` options so the detected +environment can be pinned. 163 tests / 1001 assertions passing, up from +152 / 940. + +**Phase 1 — correctness bugs, small and independent** — **done** +U2, U3, U4, P3, P7, P9, and the `$` fix in S7. U3 grew to cover `"esc"`, which +was dead everywhere; P9 grew a `:reflection` build check, which also turned up +three auto-boxing `recur` args. 163 tests / 1105 assertions passing, up from +163 / 1001. Left for later, found while here: `key-match?` ignores modifiers +outside its `"ctrl+x"` branch (now U12). + +**Phase 2 — security** — **done** +S1 + S2 + S3 as one sanitiser (`charm.ansi.sanitize`), then S4, S5, S6, and the +action pinning in S7. The J7 close-race audit landed on S5. 169 tests / 1159 +assertions passing, up from 163 / 1105. + +Two things did not go as planned. S5 could not be done via J6: `Terminal.handle` +needs nested classes babashka cannot resolve, so it uses the `Signals` helper, +which returns the previous handler just the same. And the JLine 4.4.5 bump from +Phase 0 had already closed the OSC/DCS half of S1 — the sanitizer's remaining +value is `ESC c`, CR, private CSI and C1, which are still live. Both are written +up under their items. + +**Still open from this phase:** gating the release job on a tag instead of every +push to `main` (S7), which changes how releases are cut. + +**Phase 3 — event loop** — **done** +P1 + P2 as one change, then P6, P8, U5, U6. 175 tests / 1217 assertions passing, +up from 169 / 1159. + +Two hazards that only showed up once the loop stopped rendering per message: +the frame a program quits on was dropped, and a dirty frame could be forgotten by +a later clean batch. Both under P2. U5 needed a timeout bound that the item did +not mention, or an unterminated paste freezes the input thread — found by a test +hanging. + +**Phase 4 — rendering architecture** — **P4 done, P5 rejected** +P4 landed: parse each line once in `render!`, 165 µs → 83 µs per frame on 40 +styled lines, and it turned out to be a correctness fix too — cutting a line was +dropping its styling. + +P5 was implemented far enough to measure and then reverted. +[ADR 008](adr/008-styling-currency.md) is now Rejected and carries the numbers: +re-parsing is not what costs (measuring a line costs the same either way), and +blocks win 2–4× on large content with deep layer chains while losing on +everything small — a realistic view of forty labels and a box came out 30% +slower. The ADR records the alternative worth trying instead: measure each line +once and carry the widths as numbers, which removes ~6 of the ~7 measurements per +line per render without changing the currency. + +Premise 1 under J1 (true color) and retiring the dynamic vars are unaffected by +that rejection — both are about the renderer holding the terminal at emission +time, not about the representation. + +**Phase 5 — JLine adoption + API ergonomics** — **ergonomics and J3 done** +U7, U8, U9, U10 and U12 landed together: `:overflow`, an id counter, +`merge-style`, one key matcher instead of two, and a bare key name no longer +matching a modified key. 180 tests / 1269 assertions passing, up from +176 / 1229. + +U11 turned out to need no API at all, and J3 landed as a fourth test tier. + +Still open: the J2 `KeyParser` spike, J4 (`trackMouse`) and J5 (terminal graphics). +J4's enum is not exposed to babashka's SCI, though `getEnumConstants` reaches it, so +that one needs the same care as J6 did. A layout container, which is what U11 would +have been if it were an API problem, is +[issue #19](https://github.com/TimoKramer/charm.clj/issues/19). diff --git a/README.md b/README.md index 4e6db33..0228e92 100644 --- a/README.md +++ b/README.md @@ -19,7 +19,7 @@ encounter any issues. - **Elm Architecture** - Simple init/update/view pattern for predictable state management - **UI Components** - Spinner, text-input, list, paginator, timer, progress, help, viewport, table -- **Styling** - Colors (ANSI, 256, true color), borders, padding, alignment +- **Styling** - Colors (ANSI, 256, true color, adaptive light/dark), borders, padding, alignment - **Input handling** - Keyboard and mouse events with modifier support - **Efficient rendering** - Line diffing for minimal terminal updates - **core.async** - Asynchronous command execution @@ -38,6 +38,7 @@ encounter any issues. - [Component Composition](doc/guides/component-composition.md) - [Styling Patterns](doc/guides/styling-patterns.md) - **[Examples](doc/examples/README.md)** - Runnable demo applications +- **[Changelog](CHANGELOG.md)** - Notable changes per release ## Installation @@ -94,7 +95,14 @@ Add to your `deps.edn`. Click the badges to find the latest version and git tag: :alt-screen false ; Use [alternate screen buffer](#alternate-screen-buffer) :mouse :cell ; Mouse mode: nil, :normal, :cell, :all :focus-reporting false ; Report focus in/out events - :fps 60}) ; Frames per second + :fps 60 ; Redraws per second, at most + :bracketed-paste false ; Deliver a paste as one :paste message + :ctrl-c :quit ; Or :message, to handle it yourself + :sanitize true ; Strip control sequences from the view + + ;; Color environment - detected from the terminal when omitted + :color-profile :ansi256 ; :ascii, :ansi, :ansi256 or :true-color + :dark-background? true}) ; Also skips the background query ``` #### Alternate Screen Buffer @@ -169,6 +177,8 @@ program/quit-cmd (style/hex "#ff6432") ; Hex color (style/ansi :red) ; ANSI 16 colors (style/ansi256 196) ; 256 palette +(style/adaptive (style/hex "#333333") + (style/hex "#dddddd")) ; Resolves against the background ;; Borders (require '[charm.style.border :as border]) (style/render (style/style :border border/rounded) "boxed") @@ -254,7 +264,7 @@ clojure -M:test - JDK 22+ - Clojure 1.12+ -- [JLine 3](https://github.com/jline/jline3) - Terminal I/O +- [JLine 4](https://github.com/jline/jline3) - Terminal I/O - [core.async](https://github.com/clojure/core.async) - Async message handling ## License diff --git a/bb.edn b/bb.edn index bbb9add..66f9a1f 100644 --- a/bb.edn +++ b/bb.edn @@ -1,4 +1,6 @@ -{:paths ["src" "test"] +{;; test-jvm is deliberately absent: those tests need JLine's ScreenTerminal, + ;; which is not in babashka's image, and a namespace naming it fails to load + :paths ["src" "test"] :tasks {test:bb {:extra-deps {io.github.cognitect-labs/test-runner {:git/tag "v0.5.1" :git/sha "dfb30dd"}} :task cognitect.test-runner/-main} @@ -9,6 +11,9 @@ lint {:doc "Lint code" :task (clojure "-M:lint")} + reflection {:doc "Check for reflective call sites" + :task (clojure "-M:reflection")} + test {:doc "Run tests" :task (clojure "-M:test")} @@ -16,4 +21,4 @@ :task (clojure "-T:build jar")} ci {:doc "Run ci" - :depends [test format lint build]}}} + :depends [test format lint reflection build]}}} diff --git a/deps.edn b/deps.edn index 6edddab..1fc6bc2 100644 --- a/deps.edn +++ b/deps.edn @@ -1,13 +1,15 @@ {:paths ["src"] :deps {org.clojure/clojure {:mvn/version "1.12.5"} org.clojure/core.async {:mvn/version "1.9.865"} - org.jline/jline-terminal-ffm {:mvn/version "4.3.1" + org.jline/jline-terminal-ffm {:mvn/version "4.4.5" :exclusions [org.jline/jline-native]} - org.jline/jline-reader {:mvn/version "4.3.1"}} + org.jline/jline-reader {:mvn/version "4.4.5"}} - :aliases {:test {:extra-paths ["test"] + :aliases {:test {:extra-paths ["test" "test-jvm"] :extra-deps {io.github.cognitect-labs/test-runner {:git/tag "v0.5.1" :git/sha "dfb30dd"}} - :main-opts ["-m" "cognitect.test-runner"] + ;; test-jvm holds tests that cannot load under babashka, so + ;; bb.edn deliberately does not list it + :main-opts ["-m" "cognitect.test-runner" "-d" "test" "-d" "test-jvm"] :jvm-opts ["--enable-native-access=ALL-UNNAMED"]} :repl {:extra-deps {nrepl/nrepl {:mvn/version "1.6.0"} @@ -23,7 +25,11 @@ :ns-default build} :format {:extra-deps {dev.weavejester/cljfmt {:mvn/version "0.16.3"}} - :main-opts ["-m" "cljfmt.main" "check" "src" "test"]} + :main-opts ["-m" "cljfmt.main" "check" "src" "test" "test-jvm" "dev"]} + + :reflection {:extra-paths ["dev"] + :main-opts ["-m" "reflection"] + :jvm-opts ["--enable-native-access=ALL-UNNAMED"]} :lint {:extra-deps {clj-kondo/clj-kondo {:mvn/version "2026.01.19"}} - :main-opts ["-m" "clj-kondo.main" "--fail-level" "error" "--lint" "src" "test"]}}} + :main-opts ["-m" "clj-kondo.main" "--fail-level" "error" "--lint" "src" "test" "test-jvm"]}}} diff --git a/dev/reflection.clj b/dev/reflection.clj new file mode 100644 index 0000000..117e3b4 --- /dev/null +++ b/dev/reflection.clj @@ -0,0 +1,35 @@ +(ns reflection + "Fail the build on compiler warnings - reflective calls and auto-boxing. + + Clojure only honours *warn-on-reflection* while compiling, and neither + `clojure -M` nor the test runner binds it, so this loads every namespace + under src/ with the flag on and exits non-zero if anything warned." + (:require + [clojure.java.io :as io] + [clojure.string :as str])) + +(defn- source-namespaces + "Namespace symbols for every .clj file under src/, in load order." + [] + (->> (file-seq (io/file "src")) + (filter #(str/ends-with? (.getName ^java.io.File %) ".clj")) + (map #(-> (.getPath ^java.io.File %) + (str/replace #"^src/" "") + (str/replace #"\.clj$" "") + (str/replace "_" "-") + (str/replace "/" ".") + symbol)) + sort)) + +(defn -main [& _] + (let [warnings (java.io.StringWriter.)] + (binding [*warn-on-reflection* true + *err* warnings] + (doseq [n (source-namespaces)] + (require n :reload))) + (let [out (str warnings)] + (if (str/blank? out) + (println "No compiler warnings.") + (do (print out) + (flush) + (System/exit 1)))))) diff --git a/doc/adr/003-testing-strategy.md b/doc/adr/003-testing-strategy.md index b86f668..1b8a111 100644 --- a/doc/adr/003-testing-strategy.md +++ b/doc/adr/003-testing-strategy.md @@ -1,4 +1,4 @@ -# ADR 001: Testing Strategy +# ADR 003: Testing Strategy ## Status @@ -186,3 +186,27 @@ clj -X:test # VHS visual tests (requires vhs installed) vhs < test/vhs/list-navigation.tape ``` + +## Addendum (2026-09-20): screen-grid integration tests + +Added after the decision above, which it extends rather than revises. + +Tier 2 asserts on the escape bytes the renderer wrote. That is the right level for +"did this sequence reach the terminal", and the wrong one for "what does the user +see" — those assertions break whenever JLine's `Display` changes how it moves the +cursor, even when the resulting screen is identical. + +`org.jline.utils.ScreenTerminal` is an in-memory VT emulator. `charm.test.screen` +feeds it the renderer's output and reads the cells back, so a test can assert that +row 0 reads `╭───────╮` and that those cells are red, rather than matching +cursor-movement sequences. + +Use it for what the user sees. Keep tier 2 for what goes over the wire, which is +where the sanitizer's guarantees live — "this OSC never reached the terminal" is a +statement about bytes, not about the screen. + +These tests live in `test-jvm/`, not `test/`, because `ScreenTerminal` is not in +babashka's image, and a namespace that merely names it fails to load there at +analysis time, so no runtime guard helps. `deps.edn`'s `:test` alias lists both +directories; `bb.edn` lists only `test`, which is why the babashka run reports +fewer assertions than the JVM one. diff --git a/doc/adr/004-jline-input-api-choices.md b/doc/adr/004-jline-input-api-choices.md index 33e295a..af96689 100644 --- a/doc/adr/004-jline-input-api-choices.md +++ b/doc/adr/004-jline-input-api-choices.md @@ -128,3 +128,51 @@ This decision can be revisited if: - JLine adds non-blocking variants of BindingReader - The Elm architecture is replaced with a different event model - Performance profiling shows the custom input handling is a bottleneck + +## Addendum (2026-09-20): KeyParser evaluated and not adopted + +Added after the decision above, which it confirms rather than revises. + +`org.jline.terminal.KeyParser` did not exist when this was written. +`KeyParser.parse(String)` is static and non-blocking — so none of the +BindingReader objections above apply to it — and returns a structured `KeyEvent` +carrying a type, an `EnumSet` of modifiers, arrows, function keys and specials. It +overlaps heavily with `charm.input.keys` and `charm.input.keymap`, so it was worth +measuring against them. + +Every sequence charm binds was run through it, taken from the keymap's own tables +including the generated xterm modifier combinations: + +| | count | +|---|---| +| sequences charm binds | 259 | +| KeyParser agrees | 209 | +| KeyParser disagrees | **0** | +| KeyParser cannot parse | 50 | + +**Not adopted, for three independent reasons.** + +*It cannot parse 19% of what charm needs.* The 50 gaps are not obscure: + +| gap | count | charm needs it for | +|---|---|---| +| `ESC O A/B/C/D/F/H` | 6 | arrows and home/end in application keypad mode, which real terminals send | +| `ESC [ 1~`, `4~`, `7~`, `8~` and their modifier forms | 32 | home and end on VT-style terminals | +| `ESC [ 25~` … `34~` | 8 | F13–F20 | +| `ESC [ I`, `ESC [ O` | 2 | focus reporting, a documented `run` option | +| `ESC [ 200~`, `201~` | 2 | bracketed paste, a documented `run` option | + +*It is hardcoded where `KeyMap` is terminal-aware.* charm binds from terminfo +capabilities first and falls back to standard sequences, so it follows whatever +the terminal declares. `KeyParser` has one fixed table. + +*It is not available on a supported platform.* `KeyParser` and `KeyEvent` are not +in babashka's image; `KeyMap` is. Input is core rather than test-only, so there is +no way to exclude it there. + +**What the spike did buy.** Zero disagreements across 209 sequences is an +independent check on a table charm generates itself, and it is now a standing one: +`charm.input.keyparser-test` (under `test-jvm/`, since `KeyParser` is absent from +babashka) asserts that the two agree wherever both understand a sequence, and that +the gaps above are still gaps. If JLine closes one, that test fails and this +addendum should be revisited. diff --git a/doc/adr/008-styling-currency.md b/doc/adr/008-styling-currency.md new file mode 100644 index 0000000..af580df --- /dev/null +++ b/doc/adr/008-styling-currency.md @@ -0,0 +1,303 @@ +# ADR 008: Styling Currency — What Flows Through the Layout Stack + +## Status + +Rejected. The premise below does not survive measurement — see +**Why this was rejected** at the end. The alternative it points at is recorded +there too, because the problem it describes is real even though this answer to it +is not. + +## Context + +Everything in charm's styling stack passes ANSI-encoded strings to the next +layer, and every layer re-parses them. + +`style/render` applies text style, then `pad`, then `align-vertical`, +`align-horizontal`, `apply-border`, `margin` — each splitting lines and +re-measuring each one with a fresh `AttributedString/fromAnsi`. `pad` is +representative (`charm/style/layout.clj:85`): + +```clojure +line-width (w/string-width line) ; → fromAnsi, per line, per layer +(str (styled-spaces left-pad bg) line (styled-spaces right-pad-count bg)) +``` + +Measured: + +| operation | cost | +|---|---| +| `string-width`, one 80-col styled line | 4.2 µs | +| bordered + padded 20-line box | 164 µs | +| `join-horizontal`, 4 blocks of 20×80 | 218 µs | + +Against a 16.7 ms frame at 60fps, a dashboard doing a few joins plus borders is +already a meaningful slice, and **the cost scales with layout depth, not content +size** — each nested layer re-parses what the previous one just serialised. + +Three further facts shape the decision: + +**1. charm does not emit ANSI itself.** There are exactly three emission sites, +and all three delegate to JLine: + +``` +src/charm/style/color.clj:271 (.toAnsi (AttributedString. text style)) +src/charm/style/core.clj:184 (.toAnsi (AttributedString. % attr-style)) +src/charm/style/overlay.clj:58 (.toAnsi (.toAttributedString builder)) +``` + +JLine picks the SGR codes, emits only the delta between adjacent styles, resets +at the right places, and downgrades to the terminal's capabilities. Whatever we +choose, we keep using it for that. + +`charm.style.core/attributed-string` already exists as an escape hatch from the +round-trip, and nothing in `layout`, `border` or any component uses it. + +**2. Color resolution currently has to be ambient.** `resolve-color` runs four +frames below anything holding the state: + +``` +(view state) → (list-view (:list state)) → (style/render item-style title) → resolve-color +``` + +Because `style/render` returns a finished `String`, the "is this terminal +true-color? is the background dark?" decision is made down there, in a function +whose signature is `(style & strings)`. Hence `*color-profile*` and +`*dark-background?*`, which arrived with adaptive colors and never got an ADR of +their own. They are thread-local, and `init` runs before `run` binds them. + +**3. True color has never reached the terminal.** `AttributedString.toAnsi()` +without a terminal argument collapses 24-bit color to the 256 palette, so +`(rgb 255 0 0)` emits `ESC[38;5;196m` even under the `:true-color` profile. +Fixing that needs the `toAnsi(Terminal)` overload — which only the renderer +holds. That change and this one touch the same boundary. + +## Decision + +**Carry a block of styled spans as plain Clojure data through the layout stack, +and serialise once at `render!`.** + +A rendered block is a vector of lines; a line is a vector of spans; a span is +text plus an unresolved charm style map: + +```clojure +[[{:text "Hello" :style {:fg (adaptive light dark) :bold true}} + {:text " world"}] + [{:text "line 2"}]] +``` + +Invariants: span text contains no newlines and no escape sequences; `:style` is +optional and `nil` means default; a line's display width is the sum of its +spans' widths. + +Consequences of that shape: + +- **Width measurement never parses ANSI.** Span text is plain, so + `w/string-width` on it skips `fromAnsi` entirely and keeps delegating to + JLine's `.columnLength` for wide chars and grapheme clusters (ADR 007). +- **Layout becomes structural.** `pad` prepends and appends a space span + carrying the `:bg`; `align-horizontal` appends one; `apply-border` wraps lines + in border spans. No string surgery, no re-measuring. +- **Emission stays JLine's job.** One new function reduces a block into an + `AttributedStringBuilder` via `.styled` and calls `toAnsi` — the pattern + `overlay.clj:58` already uses. This is the only place that resolves colors, + and it is the only place that needs the terminal. + +### Public API + +`style/render` keeps returning a `String`, as a thin wrapper that builds a block +and serialises it. The data path becomes the fast path, not the only path. + +This is not politeness — it avoids a *silent* break. `AttributedString` +implements `CharSequence` but its `toString` drops all styling: + +``` +toString: "hi" ; styles gone +toAnsi: "\e[38;5;196mhi\e[0m" +str: "hi" ; (str x) silently renders unstyled +``` + +`(str (style/render …) "\n" …)` is the dominant idiom in charm's own examples — +`todos`, `talk`, `countdown`, `emojis`, `spinner_demo`, `form` and others all +use it. If `render` returned spans, `(str …)` on them would break loudly, which +is survivable; if it returned an `AttributedString`, every one of those would +keep compiling and quietly lose its colors. Neither is necessary. + +`view` may return either a `String` or a block; `render!` dispatches on +`string?`. Components return blocks. + +### What happens to the dynamic vars + +- `*dark-background?*` is **retired**: adaptive spans stay unresolved until + emission, which happens in the renderer, which knows the background. +- `*color-profile*` is **retired**: `toAnsi(Terminal)` does capability-based + downgrade, which is the same call that makes true color work (fact 3). +- The `:color-profile` / `:dark-background?` options on `run` survive unchanged; + they become renderer configuration instead of dynamic bindings. + +## Consequences + +### Pros + +- Removes the re-parse per layer — the one structural change with real headroom +- Retires both dynamic vars, and with them the thread-locality caveat and the + `init`-runs-before-`binding` hole +- Lands true color for free, at the same boundary +- `view` output becomes inspectable and diffable data: the event loop's + skip-render can compare structure instead of strings, and tests can assert on + spans instead of escape sequences +- Existing tests keep passing — they assert on `style/render`'s ANSI output, + which is preserved + +### Cons + +- Touches nine component namespaces (24 `style/render` call sites) plus the + whole of `layout`, `border` and `overlay` +- Two representations coexist during migration, and `render!` must accept both +- Blocks are verbose to print when debugging +- `truncate` / `strip-ansi` need span-aware equivalents +- A style map inside every span is more allocation than an interned style table + would be; not optimising that until measured + +## Alternatives considered + +**`AttributedString` as the currency** — the obvious first instinct. Same +layout-stack rewrite, same perf win, less new code, and JLine's own type. But +`AttributedStyle` holds concrete color indices built at construction time, so +adaptive resolution still happens deep in the stack: `*dark-background?*` would +have to stay. Combined with the silent-`str`-break above, it costs the same and +delivers less. + +**Status quo, fix the round-trip locally** — use `attributed-string` inside +`style/render` only. Helps one layer; the parse comes back at the next `pad` or +`join`. Doesn't address depth, which is the actual problem. + +## Notes + +Sequencing — each step is independently shippable: + +1. Parse each line once in `render!`, truncating via `.columnLength` / + `.columnSubSequence` rather than re-parsing the truncated string. ~27% + (140 µs → 102 µs), internal, no API surface. Independent of everything below. +2. Introduce the block representation and the emission boundary + (`block->attributed-string`) alongside the current path. No public change. +3. Rewrite `layout` / `border` / `overlay` on blocks; `style/render` becomes + build-block-then-serialise. +4. `render!` accepts blocks; migrate component views. +5. Retire the dynamic vars; switch emission to `toAnsi(Terminal)` and update the + true-color assertions in `test/charm/style/color_test.clj`. + +**Step 5 can delete `downgrade-color` outright, from JLine 4.4.5 on.** +`toAnsi(Terminal)` rounds into the terminal's `ColorPalette`, which is now sized +from `max_colors`, so passing a terminal gets profile detection *and* the +downgrade — including to 8 and 16 colors, emitted as basic SGR: + +``` +TERM=xterm max=8 len=8 toAnsi="\e[31m" +TERM=xterm-16color max=16 len=16 toAnsi="\e[91m" +TERM=xterm-256color max=256 len=256 toAnsi="\e[38;5;208m" +``` + +This needed two fixes upstream, both filed from this work and released in +**4.4.5**: + +- [#2256](https://github.com/jline/jline3/issues/2256) — the palette was built in + `AbstractTerminal`'s constructor, before `parseInfoCmp()` had populated the + capabilities, so `max_colors` read back `null` and every terminal got the full + 256-entry table. Fixed by + [#2260](https://github.com/jline/jline3/pull/2260), which adds + `ColorPalette.reloadFromCapabilities()` and calls it from `parseInfoCmp()` and + `setEnv()`. +- [#2257](https://github.com/jline/jline3/issues/2257) — `loadPalette()` accepted + a one-entry all-black palette from a terminal that never answered OSC 4. Fixed + by [#2261](https://github.com/jline/jline3/pull/2261), which returns an empty + array when nothing was read and catches `ClosedException`. + +`ColorPalette.loadPalette()` is therefore safe to call from 4.4.5 on — a silent +terminal now falls back to the default table and returns `false`. It stays +optional: its value is rounding against the user's actual theme rather than a +default table. + +**This makes JLine ≥ 4.4.5 a hard floor** for step 5, which matters because +consumers can override the version. Before 4.4.5 the palette is always 256 +entries, `toAnsi(Terminal)` emits a 256-color escape to a `TERM=xterm` terminal, +and charm's own `:ansi` branch is the only thing doing that downgrade. + +Note that `charm.render.core` already renders through JLine's `Display`, which +holds `terminal.getPalette()` and emits via `toAnsiBytes(…, ColorPalette, …)`. +So from 4.4.5 the write-time rounding is live on the current code, before any of +this ADR is implemented: on an 8-color terminal charm's `\e[91m` now reaches the +terminal as `\e[31m`. That is a second reason the two downgrades should collapse +into one. + +Step 5 is where fact 3 above gets resolved — the point at which true color +actually reaches the terminal. Until then the dynamic vars stay as the interim +mechanism. + +## Why this was rejected + +Implemented far enough to measure, then reverted. Two assumptions were wrong. + +**1. Re-parsing is not what costs.** The whole argument rests on ANSI parsing per +layer being the expense. It is not: parsing a line and measuring it costs about +the same as measuring it alone, because `columnLength` has to walk the characters +for wide ones and grapheme clusters either way. Removing the parse removes almost +nothing, so neither spans-as-data nor `AttributedString` avoids the real cost. + +**2. The win does not survive realistic content.** A block amortises one +measurement across several layout layers. Measured against the string pipeline, +with span widths cached at construction and a single `StringBuilder` for emission: + +| operation | strings | blocks | +|---|---|---| +| short styled label | 0.82 µs | 1.08 µs | +| 20-line styled block, no layout | 8.8 µs | 11.5 µs | +| small box: border + padding + width | 9.0 µs | 9.8 µs | +| bordered + padded **20-line** box | 76 µs | **32 µs** | +| width + align + border + margin, 20 lines | 192 µs | **44 µs** | +| `join-horizontal`, 4 blocks of 20×80 | 177 µs | **103 µs** | +| **realistic view: 40 labels + one box** | **42 µs** | **55 µs** | + +Blocks win by 2–4× on large content with several layers stacked on it, and lose +on everything small. A view is mostly small: forty short labels and a box came +out 30% slower. Reaching parity on the small cases needed a memoised escape +table, a per-call style cache, an ASCII fast path for width, and a second +non-block path in `render` for styles with no layout — which is the tell. The +caching existed to claw back overhead the representation introduced. + +Note also that the cost table in the Context above did not reproduce: the +bordered-and-padded 20-line box measures 76–105 µs here, not 164 µs. And the +shape that actually dominates a frame — many small renders — was never measured +before the decision. + +**What is true, and what to do instead.** The real redundancy is not the +representation, it is that the same text is measured many times. One full +`style/render` over *n* lines measures roughly 7*n* times: `pad` twice per line +(once for the widest, once per line), `align-horizontal` once, `apply-border` +twice, `margin` twice. `render!` then measures again. + +Every width after the first is arithmetic — padded is `width + left + right`, +bordered is that plus the border. So measure the *n* lines once, carry the +numbers alongside the strings, and roughly 6*n* of the measurements disappear. +That keeps strings as the currency, keeps every public contract, needs no +emission boundary, no styles-as-data and no caching, and is confined to +`style/render` and the layout helpers' internals. It should reach a similar win +to the one blocks got on deep chains, without the machinery. + +**Two other things this turned up**, both since fixed independently: + +- `toAnsi` without a `Terminal` rewrites Unicode line-drawing characters as + ASCII, so any *styled* text containing them lost them — a styled border + rendered as `+--+`. That is a property of JLine's emission, not of the + currency, and it would have bitten `AttributedString`-as-currency harder: with + the text inside the object there is nowhere to put the escapes but around it. +- Parsing each line once in `render!` and slicing with `.columnSubSequence`, + rather than measuring, cutting via a string and parsing the result again, is + worth about 2× on the render path. That is `AttributedString` used at the + boundary, where it has a terminal and where parsing genuinely was repeated — + and it is the part of this ADR's instinct that paid off. + +The two motivations that do **not** depend on the performance argument — true +color never reaching the terminal (fact 3 above), and retiring the dynamic vars — +still stand on their own. Both are about the renderer holding the terminal at +emission time, which is where `render!` already builds `AttributedString`s. They +do not need a new representation to be solved. diff --git a/doc/adr/009-frame-pacing-and-command-scheduling.md b/doc/adr/009-frame-pacing-and-command-scheduling.md new file mode 100644 index 0000000..0533b6e --- /dev/null +++ b/doc/adr/009-frame-pacing-and-command-scheduling.md @@ -0,0 +1,230 @@ +# ADR 009: Frame Pacing and Command Scheduling + +## Status + +Accepted + +## Context + +The event loop polled instead of waiting, and rendered once per message: + +```clojure +(when-let [_ (a/= (- now last-render) frame-ns)) + (render! ...) ; frame is due + (let [wait-ns (if dirty? (- frame-ns (- now last-render)) frame-ns) + wait-ms (max 1 (quot wait-ns 1000000)) ; never a 0 ms spin + [m _] (a/alts!! [msg-chan (a/timeout wait-ms)])] + (recur (or (drain! ctx m) dirty?) last-render)))) +``` + +`handle-msg!` runs `update` for one message and reports whether the frame is +dirty; it does not render. `drain!` applies it to the message in hand and to +everything `poll!` yields behind it. The loop owns the render. + +**There is no separate frame-tick channel.** `alts!!` waits against a timeout +sized to the remainder of the current frame, and that timeout doubles as the poll +that notices an externally flipped `running?` — `:running?` is a public option and +`run-async`'s `:quit!` only sets that atom, so a purely blocking take would never +see it. One mechanism, two jobs. + +Two invariants are not obvious and are covered by tests: + +- **`dirty?` is `or`-ed across iterations, never replaced.** A state change + followed, inside the same frame, by messages that change nothing must not lose + its render. +- **A frame still owed is drawn on the way out.** A state change and the quit that + follows it can land in the same batch. For an alt-screen program this does not + matter, since cleanup wipes the screen, but an inline program's last view is + what stays on the terminal — a final "Done!" would otherwise never appear. + +### Skip the render when the state is unchanged + +A message that leaves the state `identical?` renders nothing: no `view`, no diff. +Identity rather than equality, because it is O(1) and the Elm shape makes it +accurate — an `update` that ignores a message returns the state it was handed. An +equal-but-fresh state still renders, which is the safe direction to err in. + +A resize is the exception and forces a render, because the frame changed even if +the application ignored the message. + +### Commands run on virtual threads + +`execute-cmd!` dispatches bodies to `a/io-thread`, which is a virtual thread where +the runtime has one: + +- **Not a `go` block**, for the reason above — commands block by nature. +- **Not `a/thread`**, because that pool is a cached pool of *platform* threads: a + burst of commands creates one OS thread each and parks them. + +The trade-off is explicit: a command doing extended *computation* rather than I/O +holds a carrier thread for the duration, where a platform thread would have been +time-sliced. Commands are documented as the place for blocking I/O; work that is +CPU-bound belongs on a thread the application manages, and `a/thread-call` takes a +`:compute` workload if that ever needs a supported route. + +`a/io-thread` conveys the thread binding frame, as `a/thread` and `go` did, so the +color environment still reaches a command that renders styled text. Where the +runtime has no virtual threads — babashka's native image — it falls back to +ordinary threads on its own. + +### Every other thread stays a platform thread + +charm creates three besides commands, and all three are single and long-lived, +which is the shape virtual threads do nothing for: + +- the **input thread** blocks in a JLine read that goes through FFM downcalls. A + native call pins its carrier, so a virtual thread would hold one of the few + carriers for no scalability gain. JDK 24's JEP 491 removed `synchronized` + pinning, not native-call pinning. +- the **shutdown hook** runs once. +- **`run-async`'s program thread** runs the whole event loop. + +It also backs off rather than spinning: the input thread used to catch and discard +every exception with no delay, so a reader that failed forever pinned a core. It +now backs off exponentially to 500 ms and, after ten consecutive failures, reports +an error and stops. + +### Keep the cheap per-frame wins honest with a build check + +The vector copies are gone (`:lines` and `content->lines` are already vectors), the +five reflective call sites are hinted, padding uses `String.repeat`, and three +`recur` args no longer auto-box. + +Because none of that is visible in behaviour, `clojure -M:reflection` loads every +namespace under `src/` with `*warn-on-reflection*` on and fails on any warning. It +lives in its own alias rather than the test alias because Clojure honours that flag +only while compiling, and neither `clojure -M` nor the test runner binds it. + +## Consequences + +### Measured + +`run-event-loop!` alone, at 60 fps. The *before* column is arithmetic, not a +measurement: the old loop slept 10 ms per message by construction. + +| messages | before | after | +|---|---|---| +| 300 | 3000 ms | 3.0 ms | +| 1000 | 10 s | 5.5 ms | +| 5000 | 50 s | 7.3 ms | + +A 300-character burst driven through `run` against a real terminal completes in +161 ms measured around the `run` call, so including terminal setup, the input +thread and teardown. A batch of 50 messages renders once. + +Commands, measured by concurrent count: + +| concurrent commands | `a/thread` | `a/io-thread` | +|---|---|---| +| 50 | +50 platform threads, 110 ms | +0, 119 ms | +| 500 | +500, 167 ms | +0, 111 ms | +| 2000 | +2000, 188 ms | +0, 146 ms | + +Twenty commands sleeping 200 ms each finish in 213 ms. On the eight-thread +dispatch pool the same twenty would have taken three waves. + +### Behavioural + +- **`:fps` is a ceiling on redraws, not a polling rate.** An idle program wakes + once a frame to observe `running?` and does nothing else — 60 wakeups a second + at the default, against 100 for the old sleep loop. +- **Quit latency is bounded by one frame**, since that is the longest the loop + waits. Flipping `:running?` from outside is noticed within the same bound. +- **The input thread's 100 ms read timeout is unchanged**, so it can take that long + to notice shutdown. It is a daemon thread, so this never delays exit. +- **A compute-heavy command now occupies a carrier thread**, as above. +- **Under babashka, commands get ordinary threads.** The thread-count test is + guarded on the runtime actually providing virtual threads, using + `Thread/activeCount` — it counts the main thread group, which virtual threads + are not part of, so it measures exactly the thing that must not grow. + +### Not addressed here + +`msg-chan` stays at 256 with `a/put!` from the input thread. Draining keeps +pending puts near zero in practice, and bracketed paste removes the one case that +could plausibly exceed 1024 — a large paste is now a single message. + +What a frame costs, as opposed to how often one happens, is a separate question. +Parsing each line once in `render!` has since landed; carrying a different +representation through the layout stack was tried and rejected, and +[ADR 008](008-styling-currency.md) records why along with what to do instead. +This ADR changes *how often* `view` and `render!` are called, not what they cost. + +## Alternatives considered + +**A separate frame-tick channel**, the obvious shape for `alts!!`. Rejected: it +needs a ticker running whether or not anything is dirty, and it still does not +solve observing `running?`. A timeout sized to the frame deadline does both jobs +with no extra channel. + +**A purely blocking take, with no timeout at all.** Cleanest loop, but `:running?` +is a documented option that external code flips directly, and `run-async`'s +`:quit!` does exactly that. A blocking take would hang until the next message +arrived, which for an idle program could be never. + +**Debouncing inside `render!` instead of in the loop.** Rejected: `view` is the +expensive half for a deep layout, so coalescing has to happen before `view` runs, +not after it has produced a string. + +**Keeping `a/thread` for commands.** Correct as far as it goes — it is off the +dispatch pool and conveys bindings — but it spends one OS thread per concurrent +command, which the table above prices. + +**A bounded executor for commands.** Rejected as premature. `io-thread` needs no +sizing decision and degrades by itself where virtual threads are absent. + +## Notes + +The benchmarks are reproducible against the private vars: + +```clojure +(def run-event-loop! #'charm.program/run-event-loop!) +(def execute-cmd! #'charm.program/execute-cmd!) +``` + +Fill `msg-chan` with *n* messages plus a `msg/quit`, redefine +`charm.render.core/render!` to count calls, and time the loop. For commands, spawn +*n* sleeping commands and sample `Thread/activeCount` while they are in flight. + +The three loop tests worth keeping in mind when changing any of this assert the +non-obvious parts rather than the throughput: that a burst coalesces to one frame, +that the frame a program quits on is drawn, and that a dirty frame survives a +later clean batch. diff --git a/doc/api/messages.md b/doc/api/messages.md index d4f2737..0830095 100644 --- a/doc/api/messages.md +++ b/doc/api/messages.md @@ -62,8 +62,8 @@ Check if a key press matches a specific key pattern. | `:escape` or `"esc"` | Escape | | `:home` | Home | | `:end` | End | -| `:pgup` | Page Up | -| `:pgdown` | Page Down | +| `:page-up` or `"pgup"` | Page Up | +| `:page-down` or `"pgdown"` | Page Down | | `"ctrl+c"` | Ctrl+C | | `"ctrl+x"` | Ctrl+X | | `"alt+f"` | Alt+F | @@ -220,6 +220,72 @@ Requires `:focus-reporting true` in run options. [state nil])) ``` +## Paste Messages + +### paste / paste? + +```clojure +(msg/paste text) ; Create a paste message +(msg/paste? msg) ; => boolean +(:text msg) ; the whole pasted text +``` + +Requires `:bracketed-paste true` in run options. Without it a paste arrives as +one key press per character, indistinguishable from fast typing; with it the +whole paste is a single message. + +```clojure +(defn update-fn [state msg] + (cond + (msg/paste? msg) + [(update state :input str (:text msg)) nil] + + (msg/key-press? msg) + [(update state :input str (:key msg)) nil] + + :else + [state nil])) +``` + +A program that handles only key presses will not see pastes at all once this is +on, which is why it is off by default. + +## Environment Messages + +### environment + +```clojure +(msg/environment color-profile dark-background?) +``` + +Sent once at startup by `charm/run`, describing the terminal it detected: + +| key | value | +|---|---| +| `:color-profile` | `:ascii`, `:ansi`, `:ansi256`, or `:true-color` | +| `:dark-background?` | whether the terminal background is dark | + +Colors are already resolved against both for you — see +[Color Profiles](styling.md) and `charm/adaptive`. This message is for apps +that want to branch on the environment themselves, for example to pick an +ASCII fallback for box-drawing characters. + +### environment? + +```clojure +(msg/environment? msg) ; => boolean +``` + +```clojure +(defn update-fn [state msg] + (cond + (msg/environment? msg) + [(assoc state :dark? (:dark-background? msg)) nil] + + :else + [state nil])) +``` + ## Quit and Error Messages ### quit diff --git a/doc/api/program.md b/doc/api/program.md index 7b31350..47a6c8e 100644 --- a/doc/api/program.md +++ b/doc/api/program.md @@ -24,6 +24,141 @@ Run a TUI program with the Elm Architecture pattern. | `:focus-reporting` | boolean | `false` | Report focus in/out events | | `:fps` | int | `60` | Frames per second | | `:hide-cursor` | boolean | `true` | Hide terminal cursor | +| `:sanitize` | boolean | `true` | Drop every escape sequence but SGR styling from the view | +| `:bracketed-paste` | boolean | `false` | Deliver a paste as one [`:paste` message](messages.md#paste-messages) | +| `:ctrl-c` | keyword | `:quit` | `:quit` stops the program; `:message` delivers Ctrl+C to `update` | +| `:overflow` | keyword | `:top` | Which end to drop lines from when the view is too tall | +| `:color-profile` | keyword | `nil` | `:ascii`, `:ansi`, `:ansi256` or `:true-color`; `nil` detects from `TERM`/`COLORTERM` | +| `:dark-background?` | boolean | `nil` | `nil` queries the terminal | + +The last two pin the [color environment](styling.md#color-profiles) instead of +detecting it, for a terminal that misreports itself or a test that needs a fixed +environment. Pinning `:dark-background?` also skips the OSC 11 background query, +and with it the probe timeout that a terminal which never answers costs at every +startup. + +### Frames and throughput + +The loop blocks for messages, handles everything queued, and renders at most once +per `:fps`. So a burst of input - a paste, mouse motion under `:mouse :all`, a +batch of command results - costs one `view` and one terminal diff rather than one +each, and no message waits on a timer before it is handled. A message that leaves +the state `identical?` renders nothing at all. + +`:fps` is therefore a ceiling on redraws, not a polling rate: an idle program +does no work beyond waking once a frame to notice that it should still be +running. + +### Views taller than the terminal + +A view with more lines than the terminal has rows gets trimmed, and `:overflow` +decides which end goes: + +- `:top` (default) keeps the **last** lines. Right for an inline program, where + the newest output is at the bottom. +- `:bottom` keeps the **first** lines. Usually right for a full-screen program — + otherwise a view one line too tall loses its title, with nothing to say it did. + +Neither scrolls. For content that should scroll, use the viewport component +rather than letting the renderer trim. + +### Sizing a component to the terminal + +Components take a fixed `:height`, and `0` means unbounded. Nothing sizes itself, +so a program that wants a component to fill the screen works out how much room is +left and says so — on the `:window-size` message, which arrives once at startup and +again on every resize. + +Measure the rest of the view rather than keeping the number by hand: + +```clojure +(defn- header [state] + (str (style/render title-style "My App") "\n" + (style/render path-style (:path state)) "\n\n")) + +(defn- footer [state] + (str "\n" (help/short-help-view (:help state)))) + +(defn- rows-in [s] + ;; newlines, not str/split-lines, which drops a trailing blank line + (count (re-seq #"\n" s))) + +(defn- body-height [state] + (- (:term-height state) + (rows-in (header state)) + (rows-in (footer state)))) + +(defn update-fn [state msg] + (cond + (msg/window-size? msg) + (let [state (assoc state :term-width (:width msg) :term-height (:height msg))] + [(assoc state :body (viewport/viewport-set-dimensions + (:body state) (:width msg) (body-height state))) + nil]) + ...)) + +(defn view [state] + ;; the same header and footer that were measured, so the two cannot disagree + (str (header state) (viewport/viewport-view (:body state)) (footer state))) +``` + +The point is that `view` and the measurement share the same functions. A constant +works until someone adds a line to the view, and then it is wrong with nothing to +say so — `examples/file_browser.clj` carried `chrome-height 5` where its view used +4, and quietly wasted a row on every terminal. + +If the view ends up taller than the terminal anyway, `:overflow` above decides +which end survives. + +### Ctrl+C + +By default Ctrl+C stops the program before `update` sees it, so a program that +does not handle it can still be killed from the keyboard. There is no need to +write a `"ctrl+c"` binding for that. + +Pass `:ctrl-c :message` to take it over - to ask for confirmation before +quitting, or to use it for something else. Then it arrives as an ordinary +`"ctrl+c"` key press, and quitting is up to the application: + +```clojure +(program/run + {:init {} + :update (fn [state msg] + (if (msg/key-match? msg "ctrl+c") + [(assoc state :confirming-quit true) nil] + [state nil])) + :view view + :ctrl-c :message}) +``` + +An application that takes Ctrl+C over and then never acts on it cannot be +interrupted from the keyboard. + +### Untrusted content + +A TUI usually displays data its user did not author - filenames, log lines, HTTP +responses. Escape sequences in that data are instructions to the terminal, not +characters: `ESC c` resets it outright, a carriage return lets content overwrite +what it just drew, and a private `CSI` sequence turns into visible garbage that +also throws off every width calculation downstream. + +So the view is sanitized before it is written: everything but SGR styling is +removed, along with every control character except newline and tab. Styled +content is unaffected, and text with nothing to remove is passed through +untouched. + +Set `:sanitize false` only for a view that writes its own control sequences, and +then sanitize the untrusted parts of it yourself: + +```clojure +(require '[charm.ansi.sanitize :as sanitize]) + +(sanitize/sanitize log-line) ; keeps styling, drops the rest +(sanitize/strip log-line) ; the plain text a terminal would show +``` + +`charm.style/strip-ansi` is `strip` under another name, so it is safe to reach +for when displaying data from elsewhere. **Example:** @@ -90,6 +225,16 @@ Create a command from a function that returns a message. {:type :timer-done})) ``` +Command bodies run on their own virtual threads, so blocking in one - sleeping, +reading a file, calling an HTTP API - is expected and will not hold up the event +loop or any other command, however many are in flight. Returning `nil` sends no +message, and a command that throws becomes an +[error message](messages.md#quit-and-error-messages). + +Commands are for I/O. A command that does heavy computation rather than blocking +occupies a carrier thread while it runs, so that work belongs on a thread the +application manages itself. + ### batch ```clojure diff --git a/doc/api/styling.md b/doc/api/styling.md index ca6123b..79c9a96 100644 --- a/doc/api/styling.md +++ b/doc/api/styling.md @@ -132,6 +132,9 @@ Create a color from hex string. (charm/hex "00ff80") ; Mint green (# optional) ``` +The string must be six hex digits. Anything else throws an `ex-info` naming the +value — `(charm/hex "red")` is an error, not an unstyled string. + #### ansi ```clojure @@ -166,6 +169,50 @@ Create an ANSI 256 color (0-255). - 16-231: 6x6x6 color cube - 232-255: Grayscale ramp +#### adaptive + +```clojure +(charm/adaptive light-color dark-color) +``` + +Create a color that resolves against the terminal's background: `light-color` +is used on light backgrounds, `dark-color` on dark ones. + +```clojure +(charm/style :fg (charm/adaptive (charm/hex "#333333") + (charm/hex "#dddddd"))) +``` + +The background is detected once at startup by `charm/run` (OSC 11), and +reported to your app as an [`:environment` message](messages.md). When the +terminal doesn't answer the query, charm assumes a dark background. + +### Color Profiles + +`charm/run` detects the terminal's color profile at startup and downgrades +colors to fit it, so the same styles work everywhere: + +| profile | detected when | colors become | +|---|---|---| +| `:true-color` | `COLORTERM` is `truecolor` or `24bit` | unchanged | +| `:ansi256` | `TERM` contains `256color` | nearest of the 256 palette | +| `:ansi` | any other `TERM` | nearest of the 16 basic colors | + +Nearest is JLine's `org.jline.utils.Colors`, which measures distance in CIE Lab +rather than RGB space. +| `:ascii` | `TERM` unset or `dumb` | dropped entirely | + +Both halves of the environment can be pinned, for a terminal that misreports +itself or a test that needs a fixed environment: + +```clojure +(charm/run {:init ... :update ... :view ... + :color-profile :ansi256 + :dark-background? false}) +``` + +Outside of `charm/run` — in tests or scripts — colors are not downgraded. + ### Predefined Colors ```clojure @@ -195,7 +242,9 @@ charm/bright-white (charm/style :fg charm/red) (charm/style :fg (charm/rgb 255 128 0)) (charm/style :fg (charm/hex "#ff8000")) -(charm/style :fg 240) ; ANSI 256 shorthand +(charm/style :fg 240) ; ANSI 256 shorthand +(charm/style :fg :red) ; ANSI 16 name shorthand +(charm/style :fg "#ff8000") ; hex string shorthand ;; Background color (charm/style :bg charm/blue) @@ -303,6 +352,28 @@ Chainable functions for building styles: | `with-align` | Set horizontal alignment | | `with-valign` | Set vertical alignment | +### merge-style + +```clojure +(charm/merge-style base-style & options) +``` + +A copy of a style with the named options changed. `style` fills in every key, so +plain `merge` of two styles overwrites the base with the second one's *defaults* - +nil colors, false attributes - rather than inheriting them: + +```clojure +(def base (charm/style :fg 240 :padding [0 1])) +(def selected (charm/merge-style base :fg charm/white :bold true)) +(def dimmed (charm/merge-style base :faint true)) + +;; Options are named, so turning something off works too +(charm/merge-style selected :bold false) +``` + +Use the `with-*` functions for a single change and `merge-style` for several, or +for keys without a `with-*` of their own. + ## Examples ### Styled Text diff --git a/doc/cljdoc.edn b/doc/cljdoc.edn index 76fb5e7..ac08ad5 100644 --- a/doc/cljdoc.edn +++ b/doc/cljdoc.edn @@ -7,7 +7,9 @@ ["Paginator" {:file "doc/components/paginator.md"}] ["Timer" {:file "doc/components/timer.md"}] ["Progress" {:file "doc/components/progress.md"}] - ["Help" {:file "doc/components/help.md"}]] + ["Help" {:file "doc/components/help.md"}] + ["Viewport" {:file "doc/components/viewport.md"}] + ["Table" {:file "doc/components/table.md"}]] ["API Reference" {} ["Program" {:file "doc/api/program.md"}] ["Messages" {:file "doc/api/messages.md"}] @@ -24,4 +26,6 @@ ["ADR 004: JLine Input API Choices" {:file "doc/adr/004-jline-input-api-choices.md"}] ["ADR 005: Layout Primitives" {:file "doc/adr/005-layout-primitives.md"}] ["ADR 006: Remove charm.core Facade" {:file "doc/adr/006-remove-charm-core-facade.md"}] - ["ADR 007: Grapheme Cluster Width" {:file "doc/adr/007-grapheme-cluster-width.md"}]]]} + ["ADR 007: Grapheme Cluster Width" {:file "doc/adr/007-grapheme-cluster-width.md"}] + ["ADR 008: Styling Currency" {:file "doc/adr/008-styling-currency.md"}] + ["ADR 009: Frame Pacing and Command Scheduling" {:file "doc/adr/009-frame-pacing-and-command-scheduling.md"}]]]} diff --git a/doc/components/overview.md b/doc/components/overview.md index c2d2978..c9363b9 100644 --- a/doc/components/overview.md +++ b/doc/components/overview.md @@ -64,6 +64,8 @@ Components integrate with charm's program loop which handles: | [timer](timer.md) | Countdown/count-up timer | Yes | | [progress](progress.md) | Progress bar display | No | | [help](help.md) | Keyboard shortcut display | No | +| [viewport](viewport.md) | Scrollable window onto long text | No | +| [table](table.md) | Rows in aligned columns | No | ## Tick-based Components diff --git a/doc/components/table.md b/doc/components/table.md new file mode 100644 index 0000000..5af0c4f --- /dev/null +++ b/doc/components/table.md @@ -0,0 +1,154 @@ +# Table + +Rows in aligned columns, with an optional header and an optional cursor. + +## Quick Example + +```clojure +(require '[charm.components.table :as table]) + +(def tbl (table/table [{:title "Name" :width 20} + {:title "Role" :width 12}] + [["Ada Lovelace" "mathematician"] + ["Grace Hopper" "rear admiral"]] + :cursor 0)) + +;; In update function +(let [[tbl cmd] (table/table-update tbl msg)] + ;; the cursor has moved if msg was a navigation key + ) + +;; In view function +(table/table-view tbl) +;; Name Role +;; Ada Lovelace mathematici… +;; Grace Hopper rear admiral +``` + +## Creation Options + +```clojure +(table/table columns rows & options) +``` + +`columns` is a vector of `{:title "…" :width n}`. `:width` is required — it is +what makes the columns line up. `rows` is a vector of row vectors, one value per +column; values are run through `str`, so they need not be strings. + +| Option | Type | Default | Description | +|--------|------|---------|-------------| +| `:cursor` | int or nil | `nil` | Selected row index; `nil` means not interactive | +| `:height` | int | `0` | Visible rows; `0` shows every row | +| `:header?` | boolean | `true` | Show the header row | +| `:header-style` | style | bold | Style for the header | +| `:row-style` | style | `nil` | Style for ordinary rows | +| `:cursor-style` | style | bold cyan | Style for the selected row | +| `:keys` | map | defaults | Custom key bindings | +| `:id` | any | counter | Unique identifier | + +A cell wider than its column is truncated with `…`; a narrower one is padded. +Both are measured by display width, so CJK characters and emoji line up and +styled cells keep their styling. + +Pass `:cursor nil` for a table that only displays. The navigation keys then do +nothing, and no row is highlighted. + +## Key Bindings + +| Action | Keys | +|--------|------| +| Cursor up | `Up`, `k` | +| Cursor down | `Down`, `j` | +| Page up | `PageUp`, `Ctrl+U` | +| Page down | `PageDown`, `Ctrl+D` | +| First row | `Home`, `g` | +| Last row | `End`, `G` | + +Override any of them with `:keys`; what you pass is merged over the defaults. + +## Functions + +### table-update + +```clojure +(table/table-update tbl msg) ; => [tbl cmd] +``` + +Move the cursor in response to a navigation key, scrolling the visible window +when `:height` is set. Returns the table unchanged for anything it does not +recognise. + +### table-view + +```clojure +(table/table-view tbl) ; => string +(table/table-view tbl {:separator " │ "}) ; custom column separator +``` + +The separator defaults to two spaces. + +### Rows and cursor + +```clojure +(table/table-rows tbl) ; all rows +(table/table-set-rows tbl new-rows) ; replace them; the cursor is clamped and + ; the visible window scrolls back to the top +(table/table-row-count tbl) + +(table/table-cursor tbl) ; row index, or nil +(table/table-selected-row tbl) ; the row vector itself, or nil +(table/table-set-cursor tbl 3) ; clamped to the row range + +;; The same movements the key bindings drive +(table/cursor-up tbl) (table/cursor-down tbl) +(table/page-up tbl) (table/page-down tbl) +(table/go-to-start tbl) (table/go-to-end tbl) +``` + +## Full Example + +```clojure +(ns my-app + (:require + [charm.components.table :as table] + [charm.message :as msg] + [charm.program :as program])) + +(def columns [{:title "File" :width 30} + {:title "Size" :width 10}]) + +(def rows [["project.clj" "1.2K"] + ["deps.edn" "842B"] + ["README.md" "4.1K"]]) + +(defn init [] + [{:tbl (table/table columns rows :cursor 0 :height 10)} nil]) + +(defn update-fn [state msg] + (cond + (msg/key-match? msg "q") + [state program/quit-cmd] + + (msg/key-match? msg :enter) + [(assoc state :chosen (table/table-selected-row (:tbl state))) nil] + + :else + (let [[tbl cmd] (table/table-update (:tbl state) msg)] + [(assoc state :tbl tbl) cmd]))) + +(defn view [state] + (str (table/table-view (:tbl state)) "\n\n" + (if-let [chosen (:chosen state)] + (str "Chose: " (first chosen)) + "j/k to move, Enter to choose, q to quit"))) + +(defn -main [& _] + (program/run {:init init :update update-fn :view view :alt-screen true})) +``` + +## Scrolling long tables + +With `:height` set, the table shows that many rows and scrolls the window to keep +the cursor visible. Without it every row is rendered, and a table taller than the +terminal is trimmed by the renderer rather than scrolled — see +[`:overflow`](../api/program.md#views-taller-than-the-terminal). diff --git a/doc/components/viewport.md b/doc/components/viewport.md new file mode 100644 index 0000000..ab62fc9 --- /dev/null +++ b/doc/components/viewport.md @@ -0,0 +1,156 @@ +# Viewport + +A scrollable window onto text that is taller than the space available. + +## Quick Example + +```clojure +(require '[charm.components.viewport :as viewport]) + +(def vp (viewport/viewport long-text :width 60 :height 20)) + +;; In update function +(let [[vp cmd] (viewport/viewport-update vp msg)] + ;; vp has scrolled if msg was a navigation key + ) + +;; In view function +(viewport/viewport-view vp) ; => the 20 visible lines +``` + +## Creation Options + +```clojure +(viewport/viewport content & options) +``` + +`content` is a string, which may contain ANSI escape sequences — styled text is +measured by display width, so colours do not throw the layout off. + +| Option | Type | Default | Description | +|--------|------|---------|-------------| +| `:width` | int | `0` | Display width; `0` leaves lines as they are | +| `:height` | int | `0` | Visible height in lines; `0` shows everything | +| `:y-offset` | int | `0` | Initial scroll position, in lines | +| `:keys` | map | defaults | Custom key bindings | +| `:id` | any | counter | Unique identifier | + +With `:width` set, every visible line is padded or truncated to exactly that +width, so the viewport always occupies a rectangle. With `:height` set, short +content is padded with blank lines to fill it. + +## Key Bindings + +| Action | Keys | +|--------|------| +| Line up | `Up`, `k` | +| Line down | `Down`, `j` | +| Half page up | `Ctrl+U` | +| Half page down | `Ctrl+D` | +| Page up | `PageUp` | +| Page down | `PageDown` | +| Top | `Home`, `g` | +| Bottom | `End`, `G` | + +Override any of them with `:keys`; what you pass is merged over the defaults: + +```clojure +(viewport/viewport text :keys {:line-up ["up" "w"] :line-down ["down" "s"]}) +``` + +## Functions + +### viewport-update + +```clojure +(viewport/viewport-update vp msg) ; => [vp cmd] +``` + +Handle a navigation key. Returns the viewport unchanged for messages it does not +recognise, so it is safe to pass everything through it. + +### viewport-view + +```clojure +(viewport/viewport-view vp) ; => string +``` + +Render the visible lines. + +### Content + +```clojure +(viewport/viewport-content vp) ; the raw content string +(viewport/viewport-set-content vp new-text) ; replace it, scrolling back to the top +(viewport/viewport-line-count vp) ; total lines, not visible lines +``` + +### Dimensions + +```clojure +(viewport/viewport-set-dimensions vp 80 24) +``` + +Set width and height together — useful on a `:window-size` message. The scroll +position is clamped so a taller viewport cannot leave you past the end. + +### Scrolling + +```clojure +(viewport/viewport-scroll-to vp 100) ; jump to a line number (clamped) +(viewport/viewport-scroll-percent vp) ; => 0.0-1.0, for a scrollbar or indicator +(viewport/viewport-at-top? vp) +(viewport/viewport-at-bottom? vp) + +;; The same movements the key bindings drive +(viewport/scroll-up vp) (viewport/scroll-down vp) +(viewport/scroll-half-page-up vp) (viewport/scroll-half-page-down vp) +(viewport/scroll-page-up vp) (viewport/scroll-page-down vp) +(viewport/scroll-to-top vp) (viewport/scroll-to-bottom vp) +``` + +## Full Example + +```clojure +(ns my-app + (:require + [charm.components.viewport :as viewport] + [charm.message :as msg] + [charm.program :as program] + [clojure.string :as str])) + +(def document (str/join "\n" (map #(str "Line " %) (range 1 201)))) + +(defn init [] + [{:vp (viewport/viewport document :width 60 :height 20)} nil]) + +(defn update-fn [state msg] + (cond + (msg/key-match? msg "q") + [state program/quit-cmd] + + ;; Keep the viewport the size of the window, less the chrome below + (msg/window-size? msg) + [(update state :vp viewport/viewport-set-dimensions + (:width msg) (- (:height msg) 2)) + nil] + + :else + (let [[vp cmd] (viewport/viewport-update (:vp state) msg)] + [(assoc state :vp vp) cmd]))) + +(defn view [state] + (let [vp (:vp state)] + (str (viewport/viewport-view vp) "\n\n" + (format "%d%% j/k to scroll, q to quit" + (int (* 100 (viewport/viewport-scroll-percent vp))))))) + +(defn -main [& _] + (program/run {:init init :update update-fn :view view :alt-screen true})) +``` + +## Scrolling versus trimming + +A viewport scrolls; the renderer does not. If a view is taller than the terminal +the renderer trims it — see [`:overflow`](../api/program.md#views-taller-than-the-terminal). +Put long content in a viewport and the renderer never has to. diff --git a/doc/examples/src/examples/file_browser.clj b/doc/examples/src/examples/file_browser.clj index 92d6870..52d9bbe 100644 --- a/doc/examples/src/examples/file_browser.clj +++ b/doc/examples/src/examples/file_browser.clj @@ -36,9 +36,6 @@ (def ^:private details-width 36) -;; Header (title + path + blank line) + blank line before help + help line -(def ^:private chrome-height 5) - (defn format-size "Format file size in human-readable format." [bytes] @@ -86,18 +83,46 @@ (format-size (:size info))) :data info})) +(defn- header + "Everything the view puts above the two columns." + [state] + (str (style/render title-style "File Browser") "\n" + (style/render path-style (:current-path state)) "\n\n")) + +(defn- footer + "Everything the view puts below the two columns." + [state] + (str "\n" (help/short-help-view (:help state)))) + +(defn- rows-in + "Rows a piece of the view occupies. + + Counts newlines rather than calling str/split-lines, which drops the trailing + blank line the header deliberately ends with." + [s] + (count (re-seq #"\n" s))) + +(defn- chrome-height + "Rows spent on anything other than the two columns. + + Measured from the strings the view actually renders, so the two cannot + disagree. As a hand-kept constant this was 5 where the view uses 4, which cost + a row of listing on every terminal." + [state] + (+ (rows-in (header state)) (rows-in (footer state)))) + (defn- list-width [term-width] (max 20 (- term-width details-width))) (defn- list-height "Number of list items visible. Each item takes 2 lines (title + description)." - [term-height] - (max 3 (quot (- term-height chrome-height) 2))) + [state] + (max 3 (quot (- (:term-height state) (chrome-height state)) 2))) -(defn- make-file-list [items term-width term-height] +(defn- make-file-list [state items] (item-list/item-list items - :height (list-height term-height) - :width (list-width term-width) + :height (list-height state) + :width (list-width (:term-width state)) :show-descriptions true :cursor-style (style/style :fg style/cyan :bold true))) @@ -105,26 +130,24 @@ (let [start-path (System/getProperty "user.dir") files (list-directory start-path) items (mapv file->list-item files)] - [{:current-path start-path - :files files - :items items - :term-width 80 - :term-height 24 - :file-list (make-file-list items 80 24) - :help (help/help help-bindings :width 60)} - nil])) + ;; The list needs the chrome measured, which needs the rest of the state, so + ;; build that first and add the list to it. + (let [state {:current-path start-path + :files files + :items items + :term-width 80 + :term-height 24 + :help (help/help help-bindings :width 60)}] + [(assoc state :file-list (make-file-list state items)) nil]))) (defn navigate-to "Navigate to a directory." [state path] (let [files (list-directory path)] (if files - (let [items (mapv file->list-item files)] - (assoc state - :current-path path - :files files - :items items - :file-list (make-file-list items (:term-width state) (:term-height state)))) + (let [items (mapv file->list-item files) + state (assoc state :current-path path :files files :items items)] + (assoc state :file-list (make-file-list state items))) state))) (defn go-up @@ -154,12 +177,8 @@ ;; Window resize (msg/window-size? msg) - (let [w (:width msg) - h (:height msg)] - [(assoc state - :term-width w - :term-height h - :file-list (make-file-list (:items state) w h)) + (let [state (assoc state :term-width (:width msg) :term-height (:height msg))] + [(assoc state :file-list (make-file-list state (:items state))) nil]) ;; Go up directory @@ -217,16 +236,14 @@ :border-fg 240 :padding [0 1] :width (- details-width 2)) - content-height (* (list-height (:term-height state)) 2) + content-height (* (list-height state) 2) left-w (list-width (:term-width state))] - (str (style/render title-style "File Browser") "\n" - (style/render path-style (:current-path state)) "\n\n" + (str (header state) (two-columns file-list-view (style/render details-style details-view) left-w content-height) - "\n" - (help/short-help-view (:help state))))) + (footer state)))) (defn -main [& _args] (program/run {:init init diff --git a/doc/examples/src/examples/talk.clj b/doc/examples/src/examples/talk.clj index d755e86..b67da3b 100644 --- a/doc/examples/src/examples/talk.clj +++ b/doc/examples/src/examples/talk.clj @@ -8,6 +8,7 @@ [charm.message :as msg] [charm.program :as program] [charm.style.border :as border] + [charm.style.color :as color] [charm.style.core :as style] [clojure.java.io :as io] [clojure.string :as str])) @@ -19,8 +20,16 @@ (sort-by #(.getName %)) (mapv #(str/trimr (slurp %))))) +;; Every color is adaptive: the light variant is used on light terminal +;; backgrounds, the dark one on dark backgrounds. charm detects the background +;; once at startup and resolves these at render time. + +(def accent + "Cyan on dark, a deeper teal that stays readable on white." + (style/adaptive "#0e7490" style/cyan)) + (def title-style - (style/style :fg style/red :bold true)) + (style/style :fg (style/adaptive "#b91c1c" "#ff5f5f") :bold true)) (def item-style (style/style :fg nil)) @@ -32,39 +41,49 @@ (style/style :faint true)) (def active-dot-style - (style/style :fg style/cyan :bold true)) + (style/style :fg accent :bold true)) (def inactive-dot-style - (style/style :fg 240)) + (style/style :fg (style/adaptive 247 240))) (def paused-style - (style/style :fg (style/rgb 255 150 100) :bold true)) + (style/style :fg (style/adaptive "#c2410c" (style/rgb 255 150 100)) :bold true)) (def footer-style - (style/style :fg style/cyan :faint true)) + (style/style :fg accent :faint true)) (def footer-text "github.com/timokramer/charm.clj") ;; Reserved rows: title (1) + paginator (1) + progress (1) + hint (1) + spacers (2) = 6 (def chrome-rows 6) +(def gradient-stops + "green -> yellow -> red ramp, per background. The bar is mixed at render + time from the progress value, so it picks its stops from the detected + background rather than from style/adaptive." + {true {:start [100 220 140] :mid [255 200 100] :end [255 100 100]} + false {:start [21 128 61] :mid [180 110 0] :end [185 28 28]}}) + (defn gradient-color "Smooth green -> yellow -> red ramp based on progress. - Dim variant for the empty side of the bar." - ([p] (gradient-color p false)) - ([p dim?] + Dim variant for the empty side of the bar: darker on a dark background, + washed out towards white on a light one." + ([dark? p] (gradient-color dark? p false)) + ([dark? p dim?] (let [p (double p) + {:keys [start mid end]} (gradient-stops (boolean dark?)) ;; Two segments: 0.0..0.5 green->yellow, 0.5..1.0 yellow->red - [r1 g1 b1 r2 g2 b2 t] (if (< p 0.5) - [100 220 140 255 200 100 (* p 2.0)] - [255 200 100 255 100 100 (* (- p 0.5) 2.0)]) - r (+ r1 (* t (- r2 r1))) - g (+ g1 (* t (- g2 g1))) - b (+ b1 (* t (- b2 b1))) - factor (if dim? 0.4 1.0)] - (style/rgb (int (* r factor)) - (int (* g factor)) - (int (* b factor)))))) + [[r1 g1 b1] [r2 g2 b2] t] (if (< p 0.5) + [start mid (* p 2.0)] + [mid end (* (- p 0.5) 2.0)]) + mix (fn [a b] (+ a (* t (- b a)))) + dim (fn [v] (cond + (not dim?) v + dark? (* v 0.4) + :else (+ v (* 0.75 (- 255 v)))))] + (style/rgb (int (dim (mix r1 r2))) + (int (dim (mix g1 g2))) + (int (dim (mix b1 b2))))))) (defn format-remaining "Format milliseconds as human-readable remaining time." @@ -77,13 +96,13 @@ (defn view-timer "Full-width progress bar with remaining time, sized to the terminal." [state] - (let [{:keys [timer phase total-ms term-w]} state + (let [{:keys [timer phase total-ms term-w dark?]} state paused? (= phase :paused) done? (= phase :done) remaining (max 0 (timer/timeout timer)) elapsed (- total-ms remaining) p (if (pos? total-ms) (/ elapsed total-ms) 0.0) - color (gradient-color p) + color (gradient-color dark? p) time-text (format-remaining remaining) suffix (cond done? " TIME!" @@ -95,7 +114,7 @@ :percent p :bar-style :thick :full-style (style/style :fg color) - :empty-style (style/style :fg (gradient-color p true)))] + :empty-style (style/style :fg (gradient-color dark? p true)))] (str (progress/progress-view bar) " " (style/render (style/style :fg color :bold true) time-text) @@ -106,34 +125,49 @@ "Card sized to fill the terminal minus title and help." [{:keys [term-w term-h]}] (style/style :border border/double-border - :border-fg style/cyan + :border-fg accent :padding [1 2] :width (- term-w 2) ; -2 for left/right border :height (- term-h chrome-rows 2))) ; -2 for top/bottom border -(defn init [] - (let [talk-ms (* 10 60 1000)] - [{:pager (paginator/paginator - :total-pages (count items) - :active-style active-dot-style - :inactive-style inactive-dot-style) - :arabic (paginator/paginator +(defn parse-args + "--light / --dark force the palette instead of trusting detection. + Returns true for dark, false for light, nil to let charm decide." + [args] + (cond + (some #{"--light"} args) false + (some #{"--dark"} args) true + :else nil)) + +(defn init + ([] (init nil)) + ([forced-dark?] + (let [talk-ms (* 10 60 1000)] + [{:pager (paginator/paginator :total-pages (count items) - :type :arabic - :arabic-format "page %d of %d" - :active-style pag-style) - :term-w 80 - :term-h 24 - :talk-ms talk-ms - :total-ms talk-ms - :phase :paused - :timer (timer/timer :timeout talk-ms - :interval 100 - :running false) - :help (help/help (help/from-pairs "←/→ or h/l" "navigate" - "p" "pause/resume" - "q" "quit"))} - nil])) + :active-style active-dot-style + :inactive-style inactive-dot-style) + :arabic (paginator/paginator + :total-pages (count items) + :type :arabic + :arabic-format "page %d of %d" + :active-style pag-style) + :term-w 80 + :term-h 24 + ;; :dark? comes from the :environment message charm sends at startup, + ;; unless --light/--dark pinned it. + :dark? (if (some? forced-dark?) forced-dark? true) + :forced-dark? forced-dark? + :talk-ms talk-ms + :total-ms talk-ms + :phase :paused + :timer (timer/timer :timeout talk-ms + :interval 100 + :running false) + :help (help/help (help/from-pairs "←/→ or h/l" "navigate" + "p" "pause/resume" + "q" "quit"))} + nil]))) (defn update-fn [state msg] (let [{:keys [phase]} state] @@ -141,6 +175,11 @@ (msg/window-size? msg) [(assoc state :term-w (:width msg) :term-h (:height msg)) nil] + (msg/environment? msg) + [(cond-> state + (nil? (:forced-dark? state)) (assoc :dark? (:dark-background? msg))) + nil] + (or (msg/key-match? msg "q") (msg/key-match? msg "ctrl+c") (msg/key-match? msg "esc")) @@ -179,40 +218,47 @@ (defn view [state] (tap> state) - (let [{:keys [pager arabic term-w term-h help]} state - raw-items (page-items pager) - rows (->> raw-items - (map #(style/render item-style %)) - (str/join "\n")) - ;; Card content height = card visual - 2 borders - 2 vertical padding. - ;; The card auto-expands horizontally to fit its widest line, so use - ;; that as the alignment target rather than the configured :width. - content-rows (max 4 (- term-h chrome-rows 4)) - max-slide-w (->> raw-items - (mapcat str/split-lines) - (map count) - (apply max 0)) - content-cols (max (- term-w 6) max-slide-w) - slide-lines (inc (count (filter #{\newline} rows))) - pad-lines (max 1 (- content-rows slide-lines)) - footer-pad (apply str (repeat (max 0 (- content-cols (count footer-text))) " ")) - body (str rows - (apply str (repeat pad-lines "\n")) - footer-pad - (style/render footer-style footer-text)) - paginator (str (paginator/paginator-view pager) " " - (paginator/paginator-view arabic))] - (str (style/render title-style "babashka conf 2026 Amsterdam") "\n" - (style/render (card-style state) body) "\n" - (style/render pag-style paginator) "\n\n" - (view-timer state) "\n\n" - (style/render hint-style (help/short-help-view help))))) - -(defn -main [& _args] - (program/run {:init init - :update update-fn - :view view - :alt-screen true})) + ;; Adaptive colors resolve against the background charm detected at startup. + ;; Rebinding it from state is what lets --light/--dark reach them, the same + ;; way :dark? reaches the hand-mixed progress gradient. + (binding [color/*dark-background?* (boolean (:dark? state))] + (let [{:keys [pager arabic term-w term-h help]} state + raw-items (page-items pager) + rows (->> raw-items + (map #(style/render item-style %)) + (str/join "\n")) + ;; Card content height = card visual - 2 borders - 2 vertical padding. + ;; The card auto-expands horizontally to fit its widest line, so use + ;; that as the alignment target rather than the configured :width. + content-rows (max 4 (- term-h chrome-rows 4)) + max-slide-w (->> raw-items + (mapcat str/split-lines) + (map count) + (apply max 0)) + content-cols (max (- term-w 6) max-slide-w) + slide-lines (inc (count (filter #{\newline} rows))) + pad-lines (max 1 (- content-rows slide-lines)) + footer-pad (apply str (repeat (max 0 (- content-cols (count footer-text))) " ")) + body (str rows + (apply str (repeat pad-lines "\n")) + footer-pad + (style/render footer-style footer-text)) + paginator (str (paginator/paginator-view pager) " " + (paginator/paginator-view arabic))] + (str (style/render title-style "babashka conf 2026 Amsterdam") "\n" + (style/render (card-style state) body) "\n" + (style/render pag-style paginator) "\n\n" + (view-timer state) "\n\n" + (style/render hint-style (help/short-help-view help)))))) + +(defn -main + "Run the talk. Pass --light or --dark to override background detection." + [& args] + (let [forced-dark? (parse-args args)] + (program/run {:init #(init forced-dark?) + :update update-fn + :view view + :alt-screen true}))) (comment (def app (program/run-async {:init init diff --git a/src/charm/ansi/parser.clj b/src/charm/ansi/parser.clj index 4f043e4..500da33 100644 --- a/src/charm/ansi/parser.clj +++ b/src/charm/ansi/parser.clj @@ -126,7 +126,7 @@ result' (if (< pos start) (conj result {:type :text :content (subs s pos start)}) result)] - (recur end + (recur (long end) (rest remaining) (conj result' {:type :ansi :content raw :parsed parsed})))))))) diff --git a/src/charm/ansi/sanitize.clj b/src/charm/ansi/sanitize.clj new file mode 100644 index 0000000..7f40c15 --- /dev/null +++ b/src/charm/ansi/sanitize.clj @@ -0,0 +1,177 @@ +(ns charm.ansi.sanitize + "Make text safe to write to a terminal. + + A TUI usually renders data its user did not author - filenames, log lines, + HTTP responses. Escape sequences in that data are instructions to the + terminal, not characters: OSC 52 writes the attacker's data into the user's + system clipboard, OSC 8 hyperlinks text to somewhere other than what it + says, OSC 2 rewrites the window title, and CSI 2K with a carriage return + erases the line the content just drew. + + `sanitize` keeps the one sequence family that only paints characters - SGR, + the styling codes - and drops the rest. `strip` drops those too, leaving the + text that will actually be displayed. + + Both return the argument unchanged when there is nothing to remove, so the + common case of plain or styled text costs one scan and no allocation." + (:import + [java.lang StringBuilder])) + +;; --------------------------------------------------------------------------- +;; Character Classes +;; --------------------------------------------------------------------------- + +(def ^:private ^:const ESC 0x1b) +(def ^:private ^:const BEL 0x07) + +(defn- keep-control? + "Is this control character one we pass through? + + Newline and tab lay out text; every other one - carriage return, backspace, + BEL, the shift codes - moves or reprograms the terminal." + [^long c] + (or (= c 0x0a) (= c 0x09))) + +(defn- control? + "C0, DEL, or a C1 control character." + [^long c] + (or (< c 0x20) (= c 0x7f) (<= 0x80 c 0x9f))) + +(defn- csi-final? + "Does this byte end a CSI sequence? (0x40-0x7e)" + [^long c] + (<= 0x40 c 0x7e)) + +;; --------------------------------------------------------------------------- +;; Scanning +;; --------------------------------------------------------------------------- + +(defn- skip-csi + "Index just past the CSI sequence starting at `from` (the byte after ESC [)." + ^long [^String s ^long from] + (let [len (.length s)] + (loop [i from] + (cond + (>= i len) len + (csi-final? (int (.charAt s i))) (inc i) + :else (recur (inc i)))))) + +(defn- skip-string-sequence + "Index just past a string-terminated sequence - OSC, DCS, APC, PM or SOS - + whose data starts at `from`. These end at BEL or at ST (ESC \\), and an + unterminated one swallows the rest of the string, which is what a terminal + does with it too." + ^long [^String s ^long from] + (let [len (.length s)] + (loop [i from] + (if (>= i len) + len + (let [c (int (.charAt s i))] + (cond + (= c BEL) (inc i) + (and (= c ESC) (< (inc i) len) (= (.charAt s (inc i)) \\)) (+ i 2) + :else (recur (inc i)))))))) + +(defn- sgr? + "Is the CSI sequence between `from` and `end` an SGR (styling) sequence? + That is the one family that only paints characters." + [^String s ^long from ^long end] + (and (> end from) (= \m (.charAt s (dec end))))) + +(defn- dropping + "The builder to collect into, seeded with the `i` characters kept so far. + Called on the first drop, which is what keeps the clean case + allocation-free." + ^StringBuilder [^StringBuilder sb ^String s ^long i] + (or sb (doto (StringBuilder. (.length s)) (.append s 0 i)))) + +(defn- scan + "Copy `s` minus the sequences the policy rejects. + + `keep-sgr?` decides whether SGR (CSI ... m) survives. Returns `s` itself + when nothing was dropped." + [^String s keep-sgr?] + (let [len (.length s)] + (loop [i 0 + ^StringBuilder sb nil] + (if (>= i len) + (if sb (.toString sb) s) + (let [c (int (.charAt s i))] + (cond + ;; An escape sequence: keep only SGR, and only if asked to + (= c ESC) + (let [n (inc i) + intro (when (< n len) (.charAt s n))] + (case intro + \[ (let [end (skip-csi s (inc n))] + (if (and keep-sgr? (sgr? s i end)) + (do (when sb (.append sb s i end)) + (recur end sb)) + (recur end (dropping sb s i)))) + + (\] \P \_ \^ \X) + (recur (skip-string-sequence s (inc n)) (dropping sb s i)) + + ;; ESC at the very end of the string + nil (recur (inc i) (dropping sb s i)) + + ;; Two-character escapes like ESC c (full reset), and anything + ;; unrecognised + (recur (+ n 1) (dropping sb s i)))) + + ;; A bare control character: newline and tab lay out text, the rest + ;; move or reprogram the terminal + (control? c) + (if (keep-control? c) + (do (when sb (.append sb (char c))) + (recur (inc i) sb)) + (recur (inc i) (dropping sb s i))) + + ;; Ordinary text - the hot path, which must not allocate + :else + (do (when sb (.append sb (char c))) + (recur (inc i) sb)))))))) + +;; --------------------------------------------------------------------------- +;; Public API +;; --------------------------------------------------------------------------- + +(defn sanitize + "Remove every escape sequence except SGR styling, and every control + character except newline and tab. + + Use this on any text a terminal will display that the application did not + author itself. Styling survives, so already-styled content passes through + unchanged." + [s] + (if (nil? s) "" (scan s true))) + +(defn strip + "Remove every escape sequence, including SGR styling, and every control + character except newline and tab. + + What is left is the text the terminal would actually display." + [s] + (if (nil? s) "" (scan s false))) + +(defn strip-controls + "Remove every control character, including newline and tab, and with them + any escape sequence. + + For strings that go inside a sequence charm writes itself - a window title, + where a BEL or an ESC would end the OSC early and let the rest of the + argument start a new one." + [s] + (if (nil? s) + "" + (let [len (.length ^String s)] + (loop [i 0 + sb nil] + (if (>= i len) + (if sb (.toString ^StringBuilder sb) s) + (let [c (int (.charAt ^String s i))] + (if (control? c) + (recur (inc i) + (or sb (doto (StringBuilder. len) (.append ^String s 0 i)))) + (do (when sb (.append ^StringBuilder sb (char c))) + (recur (inc i) sb))))))))) diff --git a/src/charm/ansi/width.clj b/src/charm/ansi/width.clj index e558079..d4e86d7 100644 --- a/src/charm/ansi/width.clj +++ b/src/charm/ansi/width.clj @@ -6,15 +6,20 @@ - Wide characters (CJK, emojis = 2 cells) - Combining characters (zero width) - Grapheme clusters (emoji sequences)" + (:require + [charm.ansi.sanitize :as san]) (:import [org.jline.utils AttributedString])) (defn strip-ansi - "Remove ANSI escape sequences from a string." + "Remove ANSI escape sequences from a string, leaving the text a terminal + would actually display. + + See `charm.ansi.sanitize/strip`: this removes OSC, DCS and the rest as well + as the styling codes, so it is safe to reach for when displaying data the + application did not author." [s] - (if (nil? s) - "" - (.toString (AttributedString/fromAnsi s)))) + (san/strip s)) (defn column-length "Get the display width of an AttributedString." @@ -22,8 +27,11 @@ (.columnLength attr-s)) (defn column-sub-sequence - "Get a column-based subsequence of an AttributedString." - [^AttributedString attr-s start end] + "Get a column-based subsequence of an AttributedString. + + The result keeps the styling of the columns it covers - unlike `str` on it, + which returns the plain text and drops the styling silently." + ^AttributedString [^AttributedString attr-s start end] (.columnSubSequence attr-s (int start) (int end))) (defn string-width @@ -34,6 +42,10 @@ - Combining characters count as 0 cells - Grapheme clusters (ZWJ emoji) count as 2 cells + Sequences JLine's SGR parser does not recognise are sanitized away first, so + the measurement matches what the terminal will be given rather than counting + an OSC's bytes as text. + Example: (string-width \"hello\") ; => 5 (string-width \"你好\") ; => 4 (2 wide chars) @@ -41,7 +53,7 @@ [s] (if (or (nil? s) (empty? s)) 0 - (column-length (AttributedString/fromAnsi s)))) + (column-length (AttributedString/fromAnsi (san/sanitize s))))) (defn truncate "Truncate a string to fit within a given display width. @@ -49,7 +61,8 @@ Options: :tail - String to append when truncated (default \"...\") - The tail is included in the width calculation. + The tail is included in the width calculation. Styling on the part that + survives is preserved; the tail itself is unstyled. Example: (truncate \"hello world\" 8) ; => \"hello...\" @@ -57,14 +70,22 @@ [s width & {:keys [tail] :or {tail "..."}}] (if (nil? s) s - (let [attr-s (AttributedString/fromAnsi s)] + (let [s (san/sanitize s) + attr-s (AttributedString/fromAnsi s)] (if (<= (column-length attr-s) width) s (let [tail-width (string-width tail) target-width (- width tail-width)] (if (neg? target-width) "" - (str (column-sub-sequence attr-s 0 target-width) tail))))))) + ;; .toAnsi, not str: str on an AttributedString returns the plain + ;; text, so truncating a styled line used to strip its styling + (str (.toAnsi (column-sub-sequence attr-s 0 target-width)) tail))))))) + +(defn repeat-char + "Build a string of `n` copies of `c`, without going through a seq." + ^String [c n] + (.repeat ^String (str c) (int n))) (defn pad-right "Pad a string on the right to reach a target display width." @@ -72,7 +93,7 @@ (let [current (string-width s) needed (- width current)] (if (pos? needed) - (str s (apply str (repeat needed char))) + (str s (repeat-char char needed)) s))) (defn pad-left @@ -81,5 +102,5 @@ (let [current (string-width s) needed (- width current)] (if (pos? needed) - (str (apply str (repeat needed char)) s) + (str (repeat-char char needed) s) s))) diff --git a/src/charm/components/help.clj b/src/charm/components/help.clj index 760a8d3..7ad8b62 100644 --- a/src/charm/components/help.clj +++ b/src/charm/components/help.clj @@ -8,7 +8,8 @@ ;; In view function: (help-view my-help)" - (:require [charm.style.core :as style] + (:require [charm.components.id :as id] + [charm.style.core :as style] [clojure.string :as str])) ;; --------------------------------------------------------------------------- @@ -38,7 +39,7 @@ separator " • " show-all false ellipsis "…" - id (rand-int 1000000)}}] + id (id/next-id)}}] {:type :help :id id :bindings (vec (map (fn [b] @@ -141,7 +142,7 @@ (str (str/join sep result) sep (render-bg (:bg hlp) ellipsis)) (recur (conj result rendered) (rest remaining) - new-width))))) + (long new-width)))))) ;; No width constraint (str/join sep (map #(render-binding hlp %) bindings))))) diff --git a/src/charm/components/id.clj b/src/charm/components/id.clj new file mode 100644 index 0000000..255e2a0 --- /dev/null +++ b/src/charm/components/id.clj @@ -0,0 +1,15 @@ +(ns ^:no-doc charm.components.id + "Identifiers for component instances. + + Components that schedule their own work - the spinner and the timer - route + tick messages back to themselves by comparing ids, so two components sharing + one would drive each other. A counter cannot collide; `(rand-int 1000000)` + could, with roughly a one-in-a-hundred chance once an application holds about + 150 components.") + +(defonce ^:private counter (atom 0)) + +(defn next-id + "The next component id." + [] + (swap! counter inc)) diff --git a/src/charm/components/list.clj b/src/charm/components/list.clj index 4ab33ec..5f6e818 100644 --- a/src/charm/components/list.clj +++ b/src/charm/components/list.clj @@ -9,7 +9,8 @@ ;; In view function: (list-view my-list)" - (:require [charm.style.core :as style] + (:require [charm.components.id :as id] + [charm.style.core :as style] [charm.message :as msg] [clojure.string :as str])) @@ -21,8 +22,8 @@ "Default key bindings for list navigation." {:cursor-up ["up" "k" "ctrl+p"] :cursor-down ["down" "j" "ctrl+n"] - :page-up ["pgup" "ctrl+u"] - :page-down ["pgdown" "ctrl+d"] + :page-up ["page-up" "ctrl+u"] + :page-down ["page-down" "ctrl+d"] :go-to-start ["home" "g"] :go-to-end ["end" "G"]}) @@ -86,7 +87,7 @@ item-prefix " " show-descriptions false infinite-scroll false - id (rand-int 1000000)}}] + id (id/next-id)}}] {:type :list :id id :items (vec items) diff --git a/src/charm/components/paginator.clj b/src/charm/components/paginator.clj index c3bd5e0..d448a8e 100644 --- a/src/charm/components/paginator.clj +++ b/src/charm/components/paginator.clj @@ -9,7 +9,8 @@ ;; In view function: (paginator-view pager)" - (:require [charm.style.core :as style] + (:require [charm.components.id :as id] + [charm.style.core :as style] [charm.message :as msg])) ;; --------------------------------------------------------------------------- @@ -17,8 +18,8 @@ ;; --------------------------------------------------------------------------- (def ^:private default-keys - {:next-page ["right" "l" "pgdown"] - :prev-page ["left" "h" "pgup"]}) + {:next-page ["right" "l" "page-down"] + :prev-page ["left" "h" "page-up"]}) (defn- matches-binding? "Check if a message matches any key in a binding." @@ -53,7 +54,7 @@ active-dot "•" inactive-dot "○" arabic-format "%d/%d" - id (rand-int 1000000)}}] + id (id/next-id)}}] {:type :paginator :id id :total-pages (max 1 total-pages) diff --git a/src/charm/components/progress.clj b/src/charm/components/progress.clj index bde7561..af85da6 100644 --- a/src/charm/components/progress.clj +++ b/src/charm/components/progress.clj @@ -9,7 +9,8 @@ ;; In view function: (progress-view my-progress)" - (:require [charm.style.core :as style])) + (:require [charm.components.id :as id] + [charm.style.core :as style])) ;; --------------------------------------------------------------------------- ;; Progress Bar Styles @@ -48,7 +49,7 @@ percent 0.0 bar-style :default show-percent false - id (rand-int 1000000)}}] + id (id/next-id)}}] (let [style-map (if (keyword? bar-style) (get bar-styles bar-style (:default bar-styles)) bar-style)] diff --git a/src/charm/components/spinner.clj b/src/charm/components/spinner.clj index 5314618..ef88d29 100644 --- a/src/charm/components/spinner.clj +++ b/src/charm/components/spinner.clj @@ -9,7 +9,8 @@ ;; In view function: (spinner-view my-spinner)" - (:require [charm.style.core :as style])) + (:require [charm.components.id :as id] + [charm.style.core :as style])) ;; --------------------------------------------------------------------------- ;; Spinner Types @@ -91,7 +92,7 @@ Options: :style - Style to apply to spinner (optional) :id - Unique ID for this spinner (optional)" - [type & {:keys [style id] :or {id (rand-int 1000000)}}] + [type & {:keys [style id] :or {id (id/next-id)}}] (let [spinner-type (if (keyword? type) (get spinner-types type (:dots spinner-types)) type)] diff --git a/src/charm/components/table.clj b/src/charm/components/table.clj index 9404953..ac8cedf 100644 --- a/src/charm/components/table.clj +++ b/src/charm/components/table.clj @@ -12,6 +12,7 @@ ;; In view function: (table-view tbl)" (:require + [charm.components.id :as id] [charm.ansi.width :as w] [charm.message :as msg] [charm.style.core :as style] @@ -25,8 +26,8 @@ "Default key bindings for table navigation." {:cursor-up ["up" "k"] :cursor-down ["down" "j"] - :page-up ["pgup" "ctrl+u"] - :page-down ["pgdown" "ctrl+d"] + :page-up ["page-up" "ctrl+u"] + :page-down ["page-down" "ctrl+d"] :go-to-start ["home" "g"] :go-to-end ["end" "G"]}) @@ -62,7 +63,7 @@ keys id] :or {height 0 header? true - id (rand-int 1000000)}}] + id (id/next-id)}}] {:type :table :id id :columns (vec columns) diff --git a/src/charm/components/text_input.clj b/src/charm/components/text_input.clj index 578983a..a2bd346 100644 --- a/src/charm/components/text_input.clj +++ b/src/charm/components/text_input.clj @@ -9,7 +9,8 @@ ;; In view function: (text-input-view my-input)" - (:require [charm.style.core :as style] + (:require [charm.components.id :as id] + [charm.style.core :as style] [charm.message :as msg] [clojure.string :as str])) @@ -76,7 +77,7 @@ char-limit 0 width 0 focused true - id (rand-int 1000000)}}] + id (id/next-id)}}] {:type :text-input :id id :prompt prompt diff --git a/src/charm/components/timer.clj b/src/charm/components/timer.clj index b5adce4..14144fd 100644 --- a/src/charm/components/timer.clj +++ b/src/charm/components/timer.clj @@ -9,7 +9,8 @@ ;; In view function: (timer-view my-timer)" - (:require [charm.style.core :as style])) + (:require [charm.components.id :as id] + [charm.style.core :as style])) ;; --------------------------------------------------------------------------- ;; Timer Messages @@ -62,7 +63,7 @@ :or {timeout 0 interval 1000 running true - id (rand-int 1000000)}}] + id (id/next-id)}}] {:type :timer :id id :timeout timeout ; remaining time in ms diff --git a/src/charm/components/viewport.clj b/src/charm/components/viewport.clj index 7ddb904..dea3648 100644 --- a/src/charm/components/viewport.clj +++ b/src/charm/components/viewport.clj @@ -12,6 +12,7 @@ ;; In view function: (viewport-view vp)" (:require + [charm.components.id :as id] [charm.ansi.width :as w] [charm.message :as msg] [clojure.string :as str])) @@ -26,8 +27,8 @@ :line-down ["down" "j"] :half-page-up ["ctrl+u"] :half-page-down ["ctrl+d"] - :page-up ["pgup"] - :page-down ["pgdown"] + :page-up ["page-up"] + :page-down ["page-down"] :top ["home" "g"] :bottom ["end" "G"]}) @@ -62,7 +63,7 @@ :or {width 0 height 0 y-offset 0 - id (rand-int 1000000)}}] + id (id/next-id)}}] (let [lines (split-content content)] {:type :viewport :id id @@ -254,7 +255,8 @@ ;; Determine visible range visible-lines (if (or (zero? height) (<= total height)) lines - (subvec (vec lines) y-offset + ;; :lines is always a vector, so no copy is needed + (subvec lines y-offset (min total (+ y-offset height)))) ;; Apply width constraint visible-lines (if (pos? width) diff --git a/src/charm/input/keymap.clj b/src/charm/input/keymap.clj index fb7d1f3..568bc1c 100644 --- a/src/charm/input/keymap.clj +++ b/src/charm/input/keymap.clj @@ -130,7 +130,7 @@ (defn- bind-key! "Bind a sequence to an event in the keymap. Sequence should be WITHOUT the ESC prefix (e.g., \"[A\" not \"\\e[A\")." - [^KeyMap keymap seq event] + [^KeyMap keymap ^CharSequence seq event] (.bind keymap event seq)) (defn- bind-from-capability! diff --git a/src/charm/input/keys.clj b/src/charm/input/keys.clj index 3ccdc4d..03dd9c5 100644 --- a/src/charm/input/keys.clj +++ b/src/charm/input/keys.clj @@ -122,29 +122,3 @@ ctrl (assoc :ctrl true) alt (assoc :alt true) shift (assoc :shift true))) - -(defn key-matches? - "Check if a key event matches a pattern. - Pattern can be: - - A string like \"ctrl+c\", \"alt+x\", \"enter\" - - A key type keyword like :enter, :up - - A map like {:type :runes :runes \"c\" :ctrl true}" - [key pattern] - (cond - (keyword? pattern) - (= (:type key) pattern) - - (map? pattern) - (every? (fn [[k v]] (= (get key k) v)) pattern) - - (string? pattern) - (let [parts (str/split (str/lower-case pattern) #"\+") - mods (set (butlast parts)) - key-part (last parts)] - (and (if (contains? mods "ctrl") (:ctrl key) (not (:ctrl key))) - (if (contains? mods "alt") (:alt key) (not (:alt key))) - (if (contains? mods "shift") (:shift key) (not (:shift key))) - (or (= key-part (name (:type key))) - (= key-part (:runes key))))) - - :else false)) diff --git a/src/charm/message.clj b/src/charm/message.clj index 88bb093..23381c9 100644 --- a/src/charm/message.clj +++ b/src/charm/message.clj @@ -59,6 +59,18 @@ :ctrl ctrl :shift shift}) +(defn environment + "Create an environment message describing the terminal. + Sent once at program startup so apps can branch on the environment. + + Keys: + :color-profile - :ascii, :ansi, :ansi256, or :true-color + :dark-background? - whether the terminal background is dark" + [color-profile dark-background?] + {:type :environment + :color-profile color-profile + :dark-background? dark-background?}) + (defn focus "Create a focus gained message." [] @@ -69,6 +81,15 @@ [] {:type :blur}) +(defn paste + "Create a paste message carrying the whole pasted text. + + Sent instead of one key press per character when `run` was given + `:bracketed-paste true` and the terminal supports it." + [text] + {:type :paste + :text text}) + ;; --------------------------------------------------------------------------- ;; Type Predicates ;; --------------------------------------------------------------------------- @@ -98,11 +119,21 @@ [msg] (= :error (:type msg))) +(defn paste? + "Check if message is a paste." + [msg] + (= :paste (:type msg))) + (defn mouse? "Check if message is a mouse event." [msg] (= :mouse (:type msg))) +(defn environment? + "Check if message is an environment message." + [msg] + (= :environment (:type msg))) + (defn focus? "Check if message is a focus event." [msg] @@ -117,37 +148,55 @@ ;; Key Helpers ;; --------------------------------------------------------------------------- +(def ^:private key-aliases + "Short spellings accepted in key patterns, mapped to the real key name." + {"esc" "escape" + "pgup" "page-up" + "pgdown" "page-down"}) + +(defn- key-name + "The canonical name of a key pattern part, resolving short spellings." + [k] + (let [n (if (keyword? k) (name k) k)] + (get key-aliases n n))) + (defn key-match? "Check if a key-press message matches the given key. Key can be: - A string like \"q\", \"a\" (matches character keys) - A keyword like :enter, :up, :tab (matches special keys) - - A pattern like \"ctrl+c\" (matches with modifiers)" + - A pattern like \"ctrl+c\" (matches with modifiers) + + The short spellings \"esc\", \"pgup\" and \"pgdown\" are accepted for + :escape, :page-up and :page-down. + + A key named on its own matches only the unmodified key: \"c\" does not match + Ctrl+C, and \"tab\" does not match Shift+Tab. Name the modifiers to match + those." [msg key] (when (key-press? msg) - (let [msg-key (:key msg)] + (let [msg-key (:key msg) + msg-name (if (keyword? msg-key) (name msg-key) msg-key)] (cond ;; Pattern with modifiers like "ctrl+c" (and (string? key) (string/includes? key "+")) (let [parts (string/split (string/lower-case key) #"\+") mods (set (butlast parts)) - key-part (last parts)] + key-part (key-name (last parts))] (and (if (contains? mods "ctrl") (:ctrl msg) (not (:ctrl msg))) (if (contains? mods "alt") (:alt msg) (not (:alt msg))) (if (contains? mods "shift") (:shift msg) (not (:shift msg))) - (or (= key-part (if (keyword? msg-key) (name msg-key) msg-key)) - (= key-part (str msg-key))))) - - ;; Keyword matches keyword or string - (keyword? key) - (or (= key msg-key) - (= (name key) msg-key)) - - ;; String matches string or keyword name - (string? key) - (or (= key msg-key) - (= key (when (keyword? msg-key) (name msg-key)))) + (= key-part msg-name))) + + ;; A key name, as a keyword (:up) or a string ("up", "q"). A name on its + ;; own means the unmodified key: "c" must not also fire on Ctrl+C, or an + ;; application cannot bind the two to different things. + (or (keyword? key) (string? key)) + (and (not (:ctrl msg)) + (not (:alt msg)) + (not (:shift msg)) + (= (key-name key) msg-name)) :else false)))) diff --git a/src/charm/program.clj b/src/charm/program.clj index ef45909..a461dc1 100644 --- a/src/charm/program.clj +++ b/src/charm/program.clj @@ -12,11 +12,11 @@ [charm.input.keymap :as km] [charm.message :as msg] [charm.render.core :as render] + [charm.style.color :as color] [charm.terminal :as term] - [clojure.core.async :as a :refer [>! chan close! go]]) + [clojure.core.async :as a :refer [chan close!]]) (:import - [org.jline.terminal Terminal Attributes] - [org.jline.utils Signals])) + [org.jline.terminal Terminal Attributes])) ;; --------------------------------------------------------------------------- ;; Command Helpers @@ -62,98 +62,328 @@ :mouse nil ; nil, :normal, :cell, or :all :focus-reporting false :fps 60 - :hide-cursor true}) + :hide-cursor true + :sanitize true + :bracketed-paste false + :ctrl-c :quit + :overflow :top + :color-profile nil ; nil - detect from the environment + :dark-background? nil}) ; nil - query the terminal + +(defn- resolve-color-profile + "Use a caller-supplied color profile, or detect one from the environment. + Throws an ex-info naming the value for an unknown profile." + [profile] + (cond + (nil? profile) (color/detect-color-profile) + (contains? color/color-profiles profile) profile + :else (throw (ex-info (str "Unknown color profile: " (pr-str profile)) + {:color-profile profile + :valid color/color-profiles})))) ;; --------------------------------------------------------------------------- ;; Event Loop ;; --------------------------------------------------------------------------- +(defn- run-cmd-fn! + "Call one command function and send what it returns to the channel." + [f msg-chan] + (try + (when-let [result (f)] + (a/>!! msg-chan result)) + (catch Exception e + (a/>!! msg-chan (msg/error e))))) + (defn- execute-cmd! - "Execute a command and send the resulting message to the channel." + "Execute a command and send the resulting message to the channel. + + Command bodies run on `a/io-thread`, which is a virtual thread where the + runtime has them. Two reasons, in order of how much they matter: + + Not a `go` block, because a command is arbitrary user code and is usually + where a program does its blocking work - sleeping, reading a file, calling an + HTTP API - which is exactly what a `go` block must not do. A handful of + concurrent commands would starve the dispatch pool and freeze the UI. + + Not `a/thread`, because that pool is a cached pool of platform threads: a + burst of commands creates one OS thread each and parks them. Measured at 2000 + concurrent commands, `a/thread` added 2000 platform threads while + `a/io-thread` added none. + + The trade-off is that a command doing extended *computation* rather than I/O + now occupies a carrier thread for the duration, where a platform thread would + have been time-sliced. Commands are for I/O; heavy computation belongs on a + thread the application owns. + + `a/io-thread` conveys the thread's binding frame just as `a/thread` did, so + the color environment still reaches a command that renders styled text." [cmd msg-chan] (when cmd (case (:type cmd) :cmd - (go - (try - (when-let [result ((:fn cmd))] - (>! msg-chan result)) - (catch Exception e - (>! msg-chan (msg/error e))))) + (a/io-thread (run-cmd-fn! (:fn cmd) msg-chan)) :batch (doseq [c (:cmds cmd)] (execute-cmd! c msg-chan)) :sequence - (go - (doseq [c (:cmds cmd)] - (try - (when-let [result ((:fn c))] - (>! msg-chan result)) - (catch Exception e - (>! msg-chan (msg/error e)))))) + (a/io-thread + (doseq [c (:cmds cmd)] + (run-cmd-fn! (:fn c) msg-chan))) nil))) +(defn- handle-msg! + "Run `update` for one message and execute the command it returns. + + Returns true when the frame needs redrawing: either the state changed, or the + message was a resize, where the frame changed even if the application ignored + it. Rendering itself belongs to the frame tick, not here. + + A quit message stops the loop, and an error stops it and is rethrown so it + surfaces on the caller's thread." + [{:keys [renderer update state msg-chan running? ctrl-c]} m] + (cond + (msg/quit? m) + (do (reset! running? false) false) + + ;; Ctrl+C quits unless the application asked to handle it itself, so a + ;; program whose `update` ignores it can still be killed from the keyboard. + (and (= :quit ctrl-c) (msg/key-match? m "ctrl+c")) + (do (reset! running? false) false) + + (msg/error? m) + (do (reset! running? false) + (throw (:error m))) + + :else + (let [resize? (msg/window-size? m)] + (when resize? + (render/update-size! renderer (:width m) (:height m))) + (let [old-state @state + [new-state cmd] (update old-state m)] + (reset! state new-state) + (execute-cmd! cmd msg-chan) + (or resize? (not (identical? new-state old-state))))))) + +(defn- drain! + "Handle `m` and every message already queued behind it. + + Returns true if any of them dirtied the frame. Stops early once the loop is + no longer running, so nothing is processed after a quit." + [{:keys [msg-chan running?] :as ctx} m] + (loop [m m + dirty? false] + (if (nil? m) + dirty? + (let [dirty? (or (handle-msg! ctx m) dirty?)] + (if @running? + (recur (a/poll! msg-chan) dirty?) + dirty?))))) + +(defn- run-event-loop! + "Block for messages, drain everything queued, and render at most once a frame. + + Waiting rather than sleeping is what lifts the input ceiling: every message + used to wait up to 10 ms and only one was handled per tick, so a + 300-character paste took three seconds. Rendering on the frame tick rather + than per message is what makes `:fps` mean anything - a burst of messages now + costs one `view` and one diff instead of one each." + [{:keys [renderer view state msg-chan running? fps] :as ctx}] + (let [frame-ns (quot 1000000000 (long (max 1 fps)))] + (loop [dirty? false + last-render (System/nanoTime)] + (if-not @running? + ;; Draw the frame still owed on the way out: a program that quits on the + ;; same key that changed its state would otherwise never show its last + ;; view, which for an inline program is the one left on screen. + (when dirty? + (render/render! renderer (view @state))) + (let [now (System/nanoTime)] + (if (and dirty? (>= (- now last-render) frame-ns)) + (do (render/render! renderer (view @state)) + (recur false now)) + ;; Wait for work, but never past the frame deadline, so a pending + ;; render and an externally flipped `running?` are both noticed. + (let [wait-ns (if dirty? (- frame-ns (- now last-render)) frame-ns) + wait-ms (max 1 (quot wait-ns 1000000)) + [m _] (a/alts!! [msg-chan (a/timeout wait-ms)])] + ;; `or`, not `=`: a frame already owed must not be forgotten + ;; because the next batch of messages changed nothing. + (recur (or (drain! ctx m) dirty?) last-render)))))))) + +(def ^:private wheel-buttons + "Mouse button codes the terminal reports for wheel movement." + {4 :wheel-up 5 :wheel-down 6 :wheel-left 7 :wheel-right}) + +(def ^:private mouse-buttons + {0 :left 1 :middle 2 :right}) + +(defn- event->msg + "Convert one input event into a message." + [event] + (case (:type event) + :mouse + (let [button (int (:button event)) + wheel (get wheel-buttons button)] + (msg/mouse (or wheel (:action event)) + (if wheel :none (get mouse-buttons button :none)) + (:x event) (:y event) + :ctrl (boolean (:ctrl event)) + :alt (boolean (:alt event)) + :shift (boolean (:shift event)))) + + :focus (msg/focus) + :blur (msg/blur) + + ;; A :runes event carries the characters typed; everything else is named by + ;; its type, which is the key name. + ;; `boolean`, because an event map simply omits the modifiers it does not + ;; carry, and key-press documents them as false rather than nil + (msg/key-press (if (= :runes (:type event)) + (:runes event) + (:type event)) + :ctrl (boolean (:ctrl event)) + :alt (boolean (:alt event)) + :shift (boolean (:shift event))))) + +(def ^:private paste-read-timeout-ms 100) + +(def ^:private max-paste-timeouts + "Consecutive read timeouts that end a paste that never sent its end marker. + + A paste arrives as one contiguous burst, so a few hundred milliseconds of + silence means the terminal is not going to finish it. Without a bound here a + truncated paste sequence would keep the input thread in this loop forever and + the application would stop seeing input entirely." + 3) + +(defn- read-paste + "Collect everything between a paste-start marker and its paste-end. + + Returns the pasted text. Without this the characters arrive as ordinary key + presses and the markers are indistinguishable from typed input, so an + application cannot tell a paste from someone typing very fast." + [^Terminal terminal keymap running?] + (let [sb (StringBuilder.)] + (loop [timeouts 0] + (if (or (not @running?) (>= timeouts max-paste-timeouts)) + (.toString sb) + (let [event (input/read-event terminal + :timeout-ms paste-read-timeout-ms + :keymap keymap)] + (case (:type event) + :paste-end (.toString sb) + :runes (do (.append sb ^String (:runes event)) (recur 0)) + ;; A newline or tab inside a paste is text, not a key press + :enter (do (.append sb "\n") (recur 0)) + :tab (do (.append sb "\t") (recur 0)) + ;; nil is a read timeout - the paste may still be arriving + nil (recur (inc timeouts)) + ;; Anything else cannot be part of the pasted text; drop it and keep + ;; going rather than ending the paste early + (recur 0))))))) + +(def ^:private max-input-failures + "Consecutive read failures tolerated before giving up on the terminal. + + A reader that fails forever would otherwise spin this thread at 100% of a + core, since every exception was caught and discarded with no backoff." + 10) + +(defn- input-backoff-ms + "Milliseconds to wait after `failures` consecutive read failures." + ^long [failures] + (min 500 (bit-shift-left 1 (min 9 (long failures))))) + (defn- start-input-loop! "Start reading terminal input and sending to message channel. Returns the thread so it can be interrupted on shutdown." [^Terminal terminal msg-chan running?] (let [;; Create terminal-aware keymap for escape sequence lookup keymap (km/create-keymap terminal) - thread (Thread. - (fn [] - (while @running? - (try - (when-let [event (input/read-event terminal - :timeout-ms 100 - :keymap keymap)] - ;; Convert input event to message - (let [m (cond - (= :mouse (:type event)) - (let [raw-button (:button event) - wheel (case (int raw-button) - 4 :wheel-up 5 :wheel-down - 6 :wheel-left 7 :wheel-right - nil)] - (msg/mouse (if wheel wheel (:action event)) - (if wheel - :none - (case (int raw-button) - 0 :left 1 :middle 2 :right - :none)) - (:x event) (:y event) - :ctrl (:ctrl event) - :alt (:alt event) - :shift (:shift event))) - - (= :focus (:type event)) - (msg/focus) - - (= :blur (:type event)) - (msg/blur) - - :else - ;; For :runes type, use the runes as key; otherwise use type - (let [key (if (= :runes (:type event)) - (:runes event) - (:type event))] - (msg/key-press key - :ctrl (:ctrl event) - :alt (:alt event) - :shift (:shift event))))] - (when m - (a/put! msg-chan m)))) - (catch InterruptedException _ - (reset! running? false)) - (catch Exception _ - ;; Ignore read errors during shutdown - nil)))))] + thread + (Thread. + (fn [] + (loop [failures 0] + (when @running? + (let [failure + (try + (when-let [event (input/read-event terminal + :timeout-ms 100 + :keymap keymap)] + (a/put! msg-chan + (if (= :paste-start (:type event)) + (msg/paste (read-paste terminal keymap running?)) + (event->msg event)))) + nil + (catch InterruptedException _ + (reset! running? false) + nil) + (catch Exception e + ;; Expected while shutting down, when the reader is + ;; closed under us; only a run of them is a problem. + e))] + (cond + (not @running?) nil + + failure + (let [failures (inc failures)] + (if (>= failures max-input-failures) + (do + (a/put! msg-chan + (msg/error + (ex-info (str "Terminal input failed " + failures " times in a row; giving up") + {:failures failures} + failure))) + (reset! running? false)) + (do + (Thread/sleep (input-backoff-ms failures)) + (recur failures)))) + + :else (recur 0)))))))] (.setDaemon thread true) (.start thread) thread)) +(defn- restore-terminal! + "Put the terminal back the way it was found - `render/stop!` covers the mouse, + focus reporting, the cursor and the alternate screen; the attributes are ours + to restore. + + Runs from `run`'s finally and from the shutdown hook, so it has to tolerate + being called twice and after the terminal is already gone." + [renderer ^Terminal terminal ^Attributes original-attrs] + (try + (render/stop! renderer) + (term/set-attributes terminal original-attrs) + (catch Exception _ + ;; Nothing useful to do while unwinding, and a terminal that is already + ;; closed throws on every one of these in JLine 4. + nil))) + +(defn- add-shutdown-hook! + "Register `f` to run on JVM shutdown, returning the thread so it can be + removed again. + + `finally` does not cover System/exit or SIGTERM, and an example in this + repository calls System/exit from inside a running program - without this the + terminal is left in raw mode, cursor hidden, alternate screen active." + ^Thread [f] + (let [thread (Thread. ^Runnable f "charm-shutdown")] + (.addShutdownHook (Runtime/getRuntime) thread) + thread)) + +(defn- remove-shutdown-hook! + [^Thread thread] + (try + (.removeShutdownHook (Runtime/getRuntime) thread) + (catch IllegalStateException _ + ;; Already shutting down - the hook is running or has run. + nil))) + (defn- check-window-size! "Check terminal size and send resize message if changed." [^Terminal terminal msg-chan last-size] @@ -179,24 +409,70 @@ :focus-reporting - Report focus in/out (default: false) :fps - Frames per second (default: 60) :hide-cursor - Hide cursor (default: true) + :sanitize - Drop every escape sequence but SGR styling from the view + before it reaches the terminal (default: true). Turn this + off only for a view that authors its own control + sequences, and then sanitize untrusted parts of it with + charm.ansi.sanitize/sanitize. + :bracketed-paste - Ask the terminal to bracket pasted text (default: + false). When on, a paste arrives as a single :paste + message carrying the whole text instead of one key press + per character, so an application can tell a paste from + fast typing. Off by default, because a program that only + handles key presses would stop seeing pastes at all. + :overflow - Which end to drop lines from when the view is taller than + the terminal: :top (default) keeps the last lines, which + suits an inline program; :bottom keeps the first ones, + which is usually what a full-screen program wants, since + otherwise a view one line too tall loses its title. + :ctrl-c - What Ctrl+C does: :quit (default) stops the program + before `update` sees it, so a program that does not + handle it can still be killed from the keyboard; + :message delivers it to `update` as an ordinary + \"ctrl+c\" key press and leaves quitting to the + application. With :message, an application that never + acts on it cannot be interrupted from the keyboard. :running? - Atom to control the event loop externally (default: internal atom) + :color-profile - :ascii, :ansi, :ansi256 or :true-color, overriding + detection (default: nil, detect from $TERM/$COLORTERM) + :dark-background? - Override the terminal background query (default: nil, + query the terminal) The init function should return [initial-state cmd] or just initial-state. The update function receives (state msg) and returns [new-state cmd]. - Commands are optional and can be nil." + Commands are optional and can be nil. + + At startup an :environment message with the :color-profile and + :dark-background? in effect is sent, and both are bound for the duration of + the program so colors resolve against the actual terminal. Pinning either + option skips its detection; pinning :dark-background? also skips the + terminal background query, and with it the probe timeout that terminals + which never answer would otherwise cost at every startup." [{:keys [init update view running?] :as opts}] (let [opts (merge (default-opts) opts) - {:keys [alt-screen mouse focus-reporting fps hide-cursor]} opts + {:keys [alt-screen mouse focus-reporting fps hide-cursor sanitize + bracketed-paste ctrl-c overflow]} opts ;; Create terminal and save original attributes for restoration terminal (term/create-terminal) ^Attributes original-attrs (term/enter-raw-mode terminal) + ;; Detect the environment for adaptive styling, unless the caller + ;; pinned it. The background query reads the terminal's OSC response, + ;; so it must happen before the input loop starts consuming input. + color-profile (resolve-color-profile (:color-profile opts)) + dark-background? (if (some? (:dark-background? opts)) + (:dark-background? opts) + (term/dark-background? terminal)) + ;; Create renderer renderer (render/create-renderer terminal :fps fps :alt-screen alt-screen - :hide-cursor hide-cursor) + :hide-cursor hide-cursor + :sanitize sanitize + :bracketed-paste bracketed-paste + :overflow overflow) ;; Message channel msg-chan (chan 256) @@ -210,107 +486,85 @@ [initial-state init-cmd] (if (vector? init-result) init-result [init-result nil]) - state (atom initial-state)] - - (try - ;; Setup renderer - (render/start! renderer) - - ;; Setup mouse - (when mouse - (render/enable-mouse! renderer mouse)) - - ;; Setup focus reporting - (when focus-reporting - (render/enable-focus-reporting! renderer)) - - ;; Handle window resize signal - (Signals/register "WINCH" - (reify Runnable - (run [_] - (check-window-size! terminal msg-chan last-size)))) - - (Signals/register "INT" - (reify Runnable - (run [_] - (a/put! msg-chan (msg/key-press "c" :ctrl true))))) - - ;; Check initial window size - (check-window-size! terminal msg-chan last-size) - - ;; Start input loop (returns thread) - (let [^Thread input-thread (start-input-loop! terminal msg-chan running?)] - - ;; Execute init command - (execute-cmd! init-cmd msg-chan) - - ;; Render initial view - (render/render! renderer (view @state)) - - ;; Main event loop - (loop [] - (when @running? - (when-let [_ (a/lines content) - ;; Truncate to height (keep last lines if overflow) + ;; Drop whichever end :overflow names when the view is too tall. Dropping + ;; from the top suits an inline program, where the newest output is at the + ;; bottom; a full-screen one usually wants its first lines kept, or a view + ;; one line too tall loses its title without saying so. lines (if (and (pos? height) (> (count lines) height)) - (subvec (vec lines) (- (count lines) height)) + (if (= :bottom overflow) + (subvec lines 0 height) + (subvec lines (- (count lines) height))) lines) - ;; Truncate each line to width and convert to AttributedString + ;; One parse per line. Going through a string-returning truncate meant + ;; parsing each line up to three times a frame - once to measure, once + ;; to cut, once to hand to Display - and the cut lost the line's styling + ;; on the way back through a plain string. attributed (mapv (fn [line] - (AttributedString/fromAnsi - (scr/truncate-line line width))) + (let [^AttributedString parsed (AttributedString/fromAnsi line)] + (if (and (pos? width) (> (.columnLength parsed) width)) + (.columnSubSequence parsed 0 (int width)) + parsed))) lines)] ;; Display.update handles all the diffing internally. ;; Convert to ArrayList because JLine mutates the list internally ;; (e.g. calling .remove) and Clojure vectors are immutable. - (.update display (java.util.ArrayList. attributed) -1))) + (.update display (ArrayList. ^Collection attributed) -1))) (defn repaint! "Force a full repaint on next render." @@ -227,17 +256,21 @@ (defn start! "Start the renderer." [renderer] - (let [{:keys [alt-screen hide-cursor]} @renderer] + (let [{:keys [alt-screen hide-cursor bracketed-paste]} @renderer] (when hide-cursor (hide-cursor! renderer)) (when alt-screen (enter-alt-screen! renderer)) + (when bracketed-paste + (enable-bracketed-paste! renderer)) (swap! renderer assoc :running true))) (defn stop! "Stop the renderer and restore terminal state." [renderer] - (let [{:keys [in-alt-screen hide-cursor]} @renderer] + (let [{:keys [in-alt-screen hide-cursor bracketed-paste]} @renderer] + (when bracketed-paste + (disable-bracketed-paste! renderer)) (when in-alt-screen (exit-alt-screen! renderer)) (when hide-cursor diff --git a/src/charm/render/screen.clj b/src/charm/render/screen.clj index d7001d3..a1a1647 100644 --- a/src/charm/render/screen.clj +++ b/src/charm/render/screen.clj @@ -3,8 +3,9 @@ For cursor movement, screen clearing, and alt screen, use charm.terminal which uses JLine's capability-based approach for better terminal compatibility." - (:require [charm.ansi.width :as w] - [clojure.string :as str])) + (:require [charm.ansi.sanitize :as san] + [clojure.string :as str]) + (:import [java.util Base64])) ;; --------------------------------------------------------------------------- ;; Constants @@ -44,17 +45,39 @@ ;; Window Title (OSC 2) ;; --------------------------------------------------------------------------- -(defn set-window-title [title] - (str ESC "]2;" title "\u0007")) +(defn set-window-title + "OSC 2 sequence setting the window title. + + Control characters are removed from `title`: a BEL or an ESC in it would end + this OSC early and let the rest of the argument open one of its own." + [title] + (str ESC "]2;" (san/strip-controls title) "\u0007")) ;; --------------------------------------------------------------------------- ;; Clipboard (OSC 52) ;; --------------------------------------------------------------------------- -(defn copy-to-clipboard [^String text] - (let [encoder (java.util.Base64/getEncoder) - bytes (.getBytes text "UTF-8") - encoded (.encodeToString encoder bytes)] +(def ^:const max-clipboard-bytes + "Largest clipboard payload we will emit, in base64 characters. + + Terminals cap OSC 52 and truncate what is over the cap silently, so a + too-large copy would otherwise leave the user with a corrupted clipboard and + no error. 74994 is tmux's limit, the smallest of the common ones." + 74994) + +(defn copy-to-clipboard + "OSC 52 sequence copying `text` to the system clipboard. + + Throws an ex-info naming the size if the encoded payload exceeds + `max-clipboard-bytes`, rather than letting the terminal truncate it." + [^String text] + (let [encoded (.encodeToString (Base64/getEncoder) (.getBytes text "UTF-8"))] + (when (> (count encoded) max-clipboard-bytes) + (throw (ex-info (str "Clipboard payload of " (count encoded) + " bytes exceeds the " max-clipboard-bytes + "-byte limit terminals impose on OSC 52") + {:encoded-bytes (count encoded) + :max-bytes max-clipboard-bytes}))) (str ESC "]52;c;" encoded "\u0007"))) ;; --------------------------------------------------------------------------- @@ -68,9 +91,3 @@ (str/replace "\r\n" "\n") (str/split-lines))) -(defn truncate-line - "Truncate a line to fit within terminal width." - [line width] - (if (or (<= width 0) (<= (w/string-width line) width)) - line - (w/truncate line width :tail ""))) diff --git a/src/charm/style/border.clj b/src/charm/style/border.clj index 5d9df1d..47e9f48 100644 --- a/src/charm/style/border.clj +++ b/src/charm/style/border.clj @@ -101,7 +101,7 @@ (str result right-corner) (do (.append result middle) - (recur result (+ current-width pattern-width))))))) + (recur result (long (+ current-width pattern-width)))))))) (defn- style-text "Apply foreground and background color to text." diff --git a/src/charm/style/color.clj b/src/charm/style/color.clj index 6ec87e1..6202d2d 100644 --- a/src/charm/style/color.clj +++ b/src/charm/style/color.clj @@ -4,11 +4,12 @@ Supports: - ANSI 16 basic colors (0-15) - ANSI 256 extended palette (0-255) - - True color RGB (24-bit)" + - True color RGB (24-bit) + - Adaptive colors that resolve against the terminal background" (:require [clojure.string :as str]) (:import - [org.jline.utils AttributedString AttributedStyle])) + [org.jline.utils AttributedString AttributedStyle Colors])) ;; --------------------------------------------------------------------------- ;; Color Profile Detection @@ -19,9 +20,17 @@ #{:ascii :ansi :ansi256 :true-color}) (def ^:dynamic *color-profile* - "Current color profile. Default is true-color." + "Current color profile. Default is true-color. + Bound by charm.program/run from the detected terminal profile; + colors are downgraded to this profile at render time." :true-color) +(def ^:dynamic *dark-background?* + "Whether the terminal background is dark. Default is true. + Bound by charm.program/run from the detected terminal background; + adaptive colors resolve against this at render time." + true) + (defn detect-color-profile "Detect terminal color profile from environment. Returns :ascii, :ansi, :ansi256, or :true-color." @@ -66,11 +75,6 @@ :bright-cyan 14 :bright-white 15}) -(def ansi-hex - "ANSI 16 colors as hex values for conversion." - ["#000000" "#800000" "#008000" "#808000" "#000080" "#800080" "#008080" "#c0c0c0" - "#808080" "#ff0000" "#00ff00" "#ffff00" "#0000ff" "#ff00ff" "#00ffff" "#ffffff"]) - ;; --------------------------------------------------------------------------- ;; Color Construction ;; --------------------------------------------------------------------------- @@ -95,46 +99,156 @@ {:type :rgb :r r :g g :b b}) (defn hex - "Create a true color from a hex string like \"#ff0000\" or \"ff0000\"." + "Create a true color from a hex string like \"#ff0000\" or \"ff0000\". + + Throws an ex-info naming the value for anything that isn't six hex digits." [hex-str] (let [s (if (str/starts-with? hex-str "#") (subs hex-str 1) - hex-str) - r (Integer/parseInt (subs s 0 2) 16) - g (Integer/parseInt (subs s 2 4) 16) - b (Integer/parseInt (subs s 4 6) 16)] - (rgb r g b))) + hex-str)] + (when-not (re-matches #"[0-9a-fA-F]{6}" s) + (throw (ex-info (str "Unrecognised color value: " (pr-str hex-str) + " - hex colors are six hex digits, e.g. \"#ff0000\"") + {:color hex-str}))) + (rgb (Integer/parseInt (subs s 0 2) 16) + (Integer/parseInt (subs s 2 4) 16) + (Integer/parseInt (subs s 4 6) 16)))) (defn no-color "Create a no-color (transparent) value." [] {:type :none}) +(defn adaptive + "Create an adaptive color that resolves against the terminal background: + `light` is used on light backgrounds, `dark` on dark backgrounds. + + (adaptive (hex \"#333333\") (hex \"#dddddd\"))" + [light dark] + {:type :adaptive :light light :dark dark}) + +(defn coerce-color + "Coerce a color value to a color map. Accepts: + - color maps (returned unchanged) + - integers: ANSI 256 codes, e.g. 240 + - keywords: ANSI 16 color names, e.g. :red, :bright-blue + - strings: hex colors, e.g. \"#ff0000\" + + Returns nil for nil; throws ex-info on unrecognised values." + [color] + (cond + (nil? color) nil + (and (map? color) (:type color)) color + (integer? color) (ansi256 color) + (and (keyword? color) (contains? ansi-colors color)) (ansi color) + (string? color) (hex color) + :else (throw (ex-info (str "Unrecognised color value: " (pr-str color)) + {:color color})))) + +;; --------------------------------------------------------------------------- +;; Color Conversion +;; --------------------------------------------------------------------------- + +(defn downgrade-color + "Downgrade a color to fit a color profile. + + Nearest-color matching is JLine's (`org.jline.utils.Colors`), which searches + the whole 256-color table — the 16 basic entries included — and measures + distance in CIE Lab rather than RGB space." + [{:keys [type code r g b] :as color} profile] + (case profile + :ascii (no-color) + :ansi (case type + :ansi color + :ansi256 (ansi (Colors/roundColor (int code) 16)) + :rgb (ansi (Colors/roundRgbColor (int r) (int g) (int b) 16)) + color) + :ansi256 (case type + (:ansi :ansi256) color + :rgb (ansi256 (Colors/roundRgbColor (int r) (int g) (int b) 256)) + color) + :true-color color + color)) + +(defn resolve-color + "Resolve a color value for rendering: coerce it to a color map, pick the + light or dark variant of adaptive colors against *dark-background?*, and + downgrade it to *color-profile*. Returns nil for nil." + [color] + (when-let [color (coerce-color color)] + (-> (if (= :adaptive (:type color)) + (coerce-color (if *dark-background?* (:dark color) (:light color))) + color) + (downgrade-color *color-profile*)))) + ;; --------------------------------------------------------------------------- ;; Color Application (via JLine AttributedStyle) ;; --------------------------------------------------------------------------- (defn apply-color-fg - "Apply foreground color to an AttributedStyle." + "Resolve a color value and apply it as foreground to an AttributedStyle." ^AttributedStyle [^AttributedStyle style color] - (if (or (nil? color) (= :none (:type color))) - style - (case (:type color) - :ansi (.foreground style (int (:code color))) - :ansi256 (.foreground style (int (:code color))) - :rgb (.foreground style (int (:r color)) (int (:g color)) (int (:b color))) - style))) + (let [color (resolve-color color)] + (if (or (nil? color) (= :none (:type color))) + style + (case (:type color) + :ansi (.foreground style (int (:code color))) + :ansi256 (.foreground style (int (:code color))) + :rgb (.foreground style (int (:r color)) (int (:g color)) (int (:b color))) + style)))) (defn apply-color-bg - "Apply background color to an AttributedStyle." + "Resolve a color value and apply it as background to an AttributedStyle." ^AttributedStyle [^AttributedStyle style color] - (if (or (nil? color) (= :none (:type color))) - style - (case (:type color) - :ansi (.background style (int (:code color))) - :ansi256 (.background style (int (:code color))) - :rgb (.background style (int (:r color)) (int (:g color)) (int (:b color))) - style))) + (let [color (resolve-color color)] + (if (or (nil? color) (= :none (:type color))) + style + (case (:type color) + :ansi (.background style (int (:code color))) + :ansi256 (.background style (int (:code color))) + :rgb (.background style (int (:r color)) (int (:g color)) (int (:b color))) + style)))) + +(defn style->escapes + "The escape sequences a style emits, as [prefix suffix]. + + Read off a one-character probe rather than by styling the real text, because + `toAnsi` does two jobs: it emits the escapes, and it rewrites characters it + thinks the terminal cannot show. With no Terminal to ask about the character + set it assumes the worst and replaces Unicode line-drawing characters with + ASCII approximations - so a styled `┌──┐` arrived as `+--+` while an unstyled + one came through intact. Only the escapes are wanted here." + [^AttributedStyle style] + (let [probe (.toAnsi (AttributedString. "X" style)) + i (.indexOf probe "X")] + [(subs probe 0 i) (subs probe (inc i))])) + +(defn attributed->ansi + "Serialise an AttributedString to ANSI, leaving its characters alone. + + Only needed where one string carries several different styles, which in + practice means compositing. Anything applying a single style to text wants + `style->escapes` and a `str` - no AttributedString, and no run to find." + ^String [^AttributedString as] + (let [len (.length as) + sb (StringBuilder. (+ len 16)) + append-run! (fn [start end ^AttributedStyle style] + (let [[prefix suffix] (style->escapes style)] + (.append sb ^String prefix) + (.append sb ^String (.toString (.subSequence as (int start) (int end)))) + (.append sb ^String suffix)))] + (loop [i 1 + start 0 + ^AttributedStyle current (when (pos? len) (.styleAt as 0))] + (cond + (zero? len) nil + (>= i len) (append-run! start len current) + :else (let [^AttributedStyle style (.styleAt as i)] + (if (= style current) + (recur (inc i) start current) + (do (append-run! start i current) + (recur (inc i) i style)))))) + (.toString sb))) (defn styled-str "Create a styled string with foreground and/or background color. @@ -144,51 +258,9 @@ text (let [style (-> AttributedStyle/DEFAULT (apply-color-fg fg) - (apply-color-bg bg))] - (.toAnsi (AttributedString. ^String text style))))) - -;; --------------------------------------------------------------------------- -;; Color Conversion -;; --------------------------------------------------------------------------- - -(defn rgb->ansi256 - "Convert RGB to closest ANSI 256 color." - [{:keys [r g b]}] - (let [;; Check grayscale first (232-255) - gray-start 232 - gray-levels 24 - gray? (and (< (Math/abs (long (- r g))) 10) - (< (Math/abs (long (- g b))) 10) - (< (Math/abs (long (- r b))) 10)) - - ;; Convert to 6x6x6 color cube (16-231) - cube-value (fn [v] (int (Math/round (/ (* v 5.0) 255.0)))) - cube-r (cube-value r) - cube-g (cube-value g) - cube-b (cube-value b)] - (if gray? - ;; Map to grayscale ramp - (let [gray-idx (int (Math/round (* (/ (+ r g b) 3.0 255.0) (dec gray-levels))))] - (ansi256 (+ gray-start gray-idx))) - ;; Map to 6x6x6 color cube - (ansi256 (+ 16 (* 36 cube-r) (* 6 cube-g) cube-b))))) - -(defn downgrade-color - "Downgrade a color to fit a color profile." - [color profile] - (case profile - :ascii (no-color) - :ansi (case (:type color) - :ansi color - :ansi256 (ansi (mod (:code color) 16)) - :rgb (ansi (mod (:code (rgb->ansi256 color)) 16)) - color) - :ansi256 (case (:type color) - (:ansi :ansi256) color - :rgb (rgb->ansi256 color) - color) - :true-color color - color)) + (apply-color-bg bg)) + [prefix suffix] (style->escapes style)] + (str prefix text suffix)))) ;; --------------------------------------------------------------------------- ;; Convenience Colors diff --git a/src/charm/style/core.clj b/src/charm/style/core.clj index 2f78db6..8d341de 100644 --- a/src/charm/style/core.clj +++ b/src/charm/style/core.clj @@ -21,7 +21,8 @@ "Create a style map. Options: - ;; Colors + ;; Colors (a color map, an ANSI 256 int like 240, an ANSI 16 + ;; name keyword like :red, or a hex string like \"#ff8000\") :fg - Foreground color :bg - Background color @@ -32,6 +33,7 @@ :blink - Blinking text :faint - Faint/dim text :reverse - Reverse video + :strikethrough - Strikethrough text ;; Dimensions :width - Fixed width (pads/truncates) @@ -41,9 +43,9 @@ :align - Horizontal alignment (:left :center :right) :valign - Vertical alignment (:top :center :bottom) - ;; Spacing - :padding - Padding [top right bottom left] or single value - :margin - Margin [top right bottom left] or single value + ;; Spacing (1-4 values in CSS order, or a bare number for all sides) + :padding - Padding [top right bottom left] + :margin - Margin [top right bottom left] ;; Border :border - Border style (from charm.style.border) @@ -53,31 +55,53 @@ ;; Rendering :inline - Remove newlines when true" [& {:as opts}] - (merge - {:fg nil - :bg nil - :bold false - :italic false - :underline false - :blink false - :faint false - :reverse false - :width nil - :height nil - :align :left - :valign :top - :padding nil - :margin nil - :border nil - :border-fg nil - :border-bg nil - :inline false} - opts)) + (cond-> (merge + {:fg nil + :bg nil + :bold false + :italic false + :underline false + :blink false + :faint false + :reverse false + :strikethrough false + :width nil + :height nil + :align :left + :valign :top + :padding nil + :margin nil + :border nil + :border-fg nil + :border-bg nil + :inline false} + opts) + (:padding opts) (update :padding l/normalize-box) + (:margin opts) (update :margin l/normalize-box))) ;; --------------------------------------------------------------------------- ;; Style Modifiers ;; --------------------------------------------------------------------------- +(defn merge-style + "A copy of `s` with the named options changed. + + `style` fills in every key, so `(merge base variant)` overwrites the base with + the variant's *defaults* - nil colors, false attributes - instead of + inheriting them. This changes only the options given, which is what building a + variant of a base style wants: + + (def base (style :fg 240 :padding [0 1])) + (def selected (merge-style base :fg :white :bold true)) + + Because the options are named rather than taken from another style map, there + is no guessing about which keys were meant: `(merge-style base :bold false)` + turns bold off." + [s & {:as opts}] + (cond-> (merge s opts) + (:padding opts) (update :padding l/normalize-box) + (:margin opts) (update :margin l/normalize-box))) + (defn with-fg "Set foreground color." [s color] @@ -103,12 +127,12 @@ (defn with-padding "Set padding. Accepts [t r b l] or single value." [s padding] - (assoc s :padding (if (number? padding) [padding] (vec padding)))) + (assoc s :padding (l/normalize-box padding))) (defn with-margin "Set margin. Accepts [t r b l] or single value." [s margin] - (assoc s :margin (if (number? margin) [margin] (vec margin)))) + (assoc s :margin (l/normalize-box margin))) (defn with-border "Set border style." @@ -144,16 +168,17 @@ Useful for direct AttributedString construction: (AttributedString. text (style->attributed-style my-style))" - ^AttributedStyle [{:keys [fg bg bold italic underline blink faint reverse]}] + ^AttributedStyle [{:keys [fg bg bold italic underline blink faint reverse strikethrough]}] (cond-> AttributedStyle/DEFAULT - bold (.bold) - faint (.faint) - italic (.italic) - underline (.underline) - blink (.blink) - reverse (.inverse) - fg (c/apply-color-fg fg) - bg (c/apply-color-bg bg))) + bold (.bold) + faint (.faint) + italic (.italic) + underline (.underline) + blink (.blink) + reverse (.inverse) + strikethrough (.crossedOut) + fg (c/apply-color-fg fg) + bg (c/apply-color-bg bg))) (defn attributed-string "Create a JLine AttributedString with the given style applied. @@ -179,9 +204,13 @@ (let [attr-style (style->attributed-style style)] (if (= attr-style AttributedStyle/DEFAULT) text - (->> (str/split-lines text) - (map #(.toAnsi (AttributedString. ^String % attr-style))) - (str/join "\n"))))) + ;; One style for the whole text, so the escapes go round each line and the + ;; text itself is untouched - JLine's toAnsi would rewrite characters it + ;; assumes the terminal cannot show. + (let [[prefix suffix] (c/style->escapes attr-style)] + (->> (str/split-lines text) + (map #(str prefix % suffix)) + (str/join "\n")))))) ;; --------------------------------------------------------------------------- ;; Rendering @@ -252,6 +281,7 @@ (def hex c/hex) (def ansi c/ansi) (def ansi256 c/ansi256) +(def adaptive c/adaptive) ;; Common colors (def black c/black) diff --git a/src/charm/style/layout.clj b/src/charm/style/layout.clj index b8c2647..bc08a3b 100644 --- a/src/charm/style/layout.clj +++ b/src/charm/style/layout.clj @@ -18,6 +18,13 @@ ;; Box Value Expansion (CSS-style) ;; --------------------------------------------------------------------------- +(defn normalize-box + "Normalize a box spec to a vector of 1-4 values. + + Accepts a bare number (applies to all sides) or a sequence of 1-4 values." + [values] + (if (number? values) [values] (vec values))) + (defn expand-box-values "Expand 1-4 values to [top right bottom left] (CSS box model). diff --git a/src/charm/style/overlay.clj b/src/charm/style/overlay.clj index 3a0749e..6ee1334 100644 --- a/src/charm/style/overlay.clj +++ b/src/charm/style/overlay.clj @@ -8,6 +8,7 @@ (center-overlay base-text overlay-text)" (:require [charm.ansi.width :as w] + [charm.style.color :as c] [clojure.string :as str]) (:import [org.jline.utils AttributedString AttributedStringBuilder])) @@ -45,17 +46,17 @@ ;; Part before overlay (when (pos? x) (let [before-width (min x base-width)] - (.append builder (w/column-sub-sequence base-attr 0 before-width)) + (.append builder ^CharSequence (w/column-sub-sequence base-attr 0 before-width)) ;; Pad if base is shorter than x (when (< base-width x) - (.append builder (apply str (repeat (- x base-width) " ")))))) + (.append builder ^CharSequence (w/repeat-char \space (- x base-width)))))) ;; Overlay content - (.append builder overlay-attr) + (.append builder ^CharSequence overlay-attr) ;; Part after overlay (let [after-start (+ x overlay-width)] (when (< after-start base-width) - (.append builder (w/column-sub-sequence base-attr after-start base-width)))) - (.toAnsi (.toAttributedString builder)))) + (.append builder ^CharSequence (w/column-sub-sequence base-attr after-start base-width)))) + (c/attributed->ansi (.toAttributedString builder)))) ;; --------------------------------------------------------------------------- ;; Public API diff --git a/src/charm/terminal.clj b/src/charm/terminal.clj index 42bea63..9e00bc3 100644 --- a/src/charm/terminal.clj +++ b/src/charm/terminal.clj @@ -1,7 +1,7 @@ (ns ^:no-doc charm.terminal "JLine terminal wrapper for charm.clj" (:import [org.jline.terminal Terminal TerminalBuilder Attributes] - [org.jline.utils InfoCmp$Capability])) + [org.jline.utils InfoCmp$Capability Signals])) (defn create-terminal "Create a JLine terminal with system I/O and FFM as native interface." @@ -29,6 +29,38 @@ [^Terminal terminal ^Attributes attrs] (.setAttributes terminal attrs)) +(defn default-foreground-color + "Get the terminal's default foreground color as a 0xRRGGBB int, + or nil if it cannot be determined." + [^Terminal terminal] + (let [color (.getDefaultForegroundColor terminal)] + (when-not (neg? color) color))) + +(defn default-background-color + "Get the terminal's default background color as a 0xRRGGBB int, + or nil if it cannot be determined. Queries the terminal (OSC 11) + where supported, so call this before reading terminal input." + [^Terminal terminal] + (let [color (.getDefaultBackgroundColor terminal)] + (when-not (neg? color) color))) + +(defn dark-color? + "True when a 0xRRGGBB color int is dark (luminance below 50%)." + [rgb] + (let [r (bit-and (unsigned-bit-shift-right rgb 16) 0xff) + g (bit-and (unsigned-bit-shift-right rgb 8) 0xff) + b (bit-and rgb 0xff)] + (< (+ (* 0.299 r) (* 0.587 g) (* 0.114 b)) 127.5))) + +(defn dark-background? + "True when the terminal's default background is dark. + Defaults to true when the background cannot be determined, + since dark terminal themes are the common case." + [^Terminal terminal] + (if-let [bg (default-background-color terminal)] + (dark-color? bg) + true)) + (defn get-size "Get terminal dimensions as {:width cols :height rows}." [^Terminal terminal] @@ -123,3 +155,41 @@ [^Terminal terminal] (.puts terminal InfoCmp$Capability/exit_ca_mode empty-args) (flush-output terminal)) + +;; --------------------------------------------------------------------------- +;; Signals +;; --------------------------------------------------------------------------- + +(def signals + "Signal names we install handlers for, by keyword." + {:int "INT" + :quit "QUIT" + :tstp "TSTP" + :cont "CONT" + :winch "WINCH"}) + +(defn handle-signal + "Install `f`, a no-argument function, as the handler for `signal` + (`:int`, `:winch`, ...). + + Returns the handler it replaced, which `restore-signal!` puts back. Leaving + a handler installed after the program exits means a later resize or Ctrl+C + still reaches a closed terminal and a closed channel - which in a REPL, where + the process outlives the program, swallows Ctrl+C for the rest of the + session. + + JLine 4 also offers `Terminal.handle`, which is the supported route and + likewise returns the previous handler, but it needs the nested + `Terminal$Signal` and `Terminal$SignalHandler` classes, which babashka cannot + resolve. This uses the static `Signals` helper, which works on both." + [signal f] + (Signals/register (get signals signal) + (reify Runnable + (run [_] (f))))) + +(defn restore-signal! + "Put back a handler that `handle-signal` returned." + [signal handler] + (when handler + (Signals/unregister (get signals signal) handler))) + diff --git a/test-jvm/charm/input/keyparser_test.clj b/test-jvm/charm/input/keyparser_test.clj new file mode 100644 index 0000000..6abe863 --- /dev/null +++ b/test-jvm/charm/input/keyparser_test.clj @@ -0,0 +1,88 @@ +(ns charm.input.keyparser-test + "Cross-check charm's escape-sequence table against JLine's own parser. + + `org.jline.terminal.KeyParser` appeared after charm's keymap was written and + parses many of the same sequences. It cannot replace the keymap - see the + addendum to ADR 004 - but where both understand a sequence they should agree, + which makes JLine an independent check on a table charm generates itself, + including the 224 xterm modifier combinations. + + Lives under test-jvm because KeyParser is not in babashka's image." + (:require + [charm.input.keymap :as km] + [clojure.test :refer [deftest is testing]]) + (:import + [org.jline.terminal KeyEvent KeyParser])) + +(def ^:private specials + {"Enter" :enter "Tab" :tab "Escape" :escape "Backspace" :backspace + "Delete" :delete "Home" :home "End" :end "PageUp" :page-up + "PageDown" :page-down "Insert" :insert}) + +(def ^:private arrows + {"Up" :up "Down" :down "Left" :left "Right" :right}) + +(defn- jline-event + "Parse an escape sequence with JLine and describe it the way charm would. + + Returns nil when JLine does not recognise the sequence." + [seq-without-esc] + (let [^KeyEvent e (KeyParser/parse (str \u001b seq-without-esc)) + mods (set (map str (.getModifiers e))) + base (case (str (.getType e)) + "Arrow" (get arrows (str (.getArrow e))) + "Special" (get specials (str (.getSpecial e))) + "Function" (keyword (str "f" (.getFunctionKey e))) + nil)] + (when base + (cond-> {:type base} + (mods "Shift") (assoc :shift true) + (mods "Alt") (assoc :alt true) + (mods "Control") (assoc :ctrl true))))) + +(def ^:private charm-corpus + "Every escape sequence charm binds, with the event it produces. + + Read from the keymap's own tables, so it cannot drift out of step with them." + (let [navigation @#'km/navigation-keys + function @#'km/function-keys + generate @#'km/generate-modified-sequences] + (distinct + (concat + (for [t (concat navigation function + @#'km/extended-function-keys + @#'km/special-keys) + s (:seqs t)] + [s (:event t)]) + (for [t (concat navigation function) + [s event] (generate (:event t) (:seqs t))] + [s event]))))) + +(deftest charm-agrees-with-jline-test + (let [checked (for [[s charm-event] charm-corpus + :let [jline (jline-event s)] + :when jline] + [s charm-event jline])] + (testing "enough of the corpus is cross-checked for this to mean something" + ;; Guards against the test quietly going vacuous if the tables move + (is (<= 200 (count checked)) + (str "only " (count checked) " of " (count charm-corpus) " were checked"))) + + (testing "charm and JLine agree on every sequence both understand" + (doseq [[s charm-event jline] checked] + (is (= charm-event jline) + (str "disagree on " (pr-str s))))))) + +(deftest jline-cannot-replace-the-keymap-test + ;; The gaps recorded in ADR 004's addendum. If JLine closes one of these, this + ;; test fails and the addendum should be revisited - that is the point of it. + (testing "JLine does not parse the sequences charm needs beyond it" + (doseq [[s what] {"OA" "SS3 up, sent in application keypad mode" + "OH" "SS3 home" + "[1~" "home, the VT-style variant" + "[4~" "end, the VT-style variant" + "[25~" "F13" + "[I" "focus in" + "[200~" "bracketed paste start"}] + (is (nil? (jline-event s)) + (str "JLine now parses " (pr-str s) " (" what ") - revisit ADR 004"))))) diff --git a/test-jvm/charm/integration/screen_test.clj b/test-jvm/charm/integration/screen_test.clj new file mode 100644 index 0000000..2323507 --- /dev/null +++ b/test-jvm/charm/integration/screen_test.clj @@ -0,0 +1,100 @@ +(ns charm.integration.screen-test + "What the user actually sees, read back off an emulated screen. + + See charm.test.screen for why these live under test-jvm." + (:require + [charm.components.table :as table] + [charm.components.viewport :as viewport] + [charm.style.border :as border] + [charm.style.core :as style] + [charm.style.overlay :as overlay] + [charm.test.screen :as screen] + [clojure.string :as str] + [clojure.test :refer [deftest is testing]])) + +(deftest plain-content-test + (testing "lines land on the rows they belong to, at column 0" + (let [s (screen/render-screen "aaa\nbbb\nccc" [20 4])] + (is (= ["aaa" "bbb" "ccc" ""] (mapv #(str/trimr %) (:grid s)))))) + + (testing "a line wider than the screen is cut, not wrapped" + (let [s (screen/render-screen "0123456789" [4 2])] + (is (= "0123" (screen/row-text s 0))) + ;; not wrapped onto the next row + (is (= "" (screen/row-text s 1)))))) + +(deftest border-reaches-the-screen-test + ;; The renderer sends box-drawing characters as ACS escapes on a terminal that + ;; wants them, so asserting on bytes says little; the emulator decodes them + ;; back, which is what the user sees. + (testing "an unstyled box draws box-drawing characters" + (let [s (screen/render-screen + (style/render (style/style :border border/rounded :padding [0 1]) "hello") + [20 4])] + (is (= ["╭───────╮" "│ hello │" "╰───────╯"] (take 3 (map str/trimr (:grid s))))))) + + (testing "a styled box draws the same characters, coloured" + ;; This is the regression that mattered: styling used to replace them with + ;; +--+ because toAnsi rewrites characters when it has no terminal to ask + (let [s (screen/render-screen + (style/render (style/style :border border/rounded :border-fg :red + :padding [0 1]) "hello") + [20 4])] + (is (= "╭───────╮" (screen/row-text s 0))) + (is (= \╭ (:char (screen/cell s 0 0)))) + ;; the border is coloured and the text inside it is not + (is (some? (:fg (screen/cell s 0 0)))) + (is (nil? (:fg (screen/cell s 1 2))))))) + +(deftest styling-reaches-the-screen-test + (testing "bold and colour arrive as cell attributes" + (let [s (screen/render-screen + (str (style/render (style/style :bold true) "BOLD") " " + (style/render (style/style :fg :red) "red") " plain") + [20 2])] + (is (= "BOLD red plain" (screen/row-text s 0))) + (is (true? (:bold? (screen/cell s 0 0)))) + (is (false? (:bold? (screen/cell s 0 5)))) + (is (some? (:fg (screen/cell s 0 5)))) + (is (nil? (:fg (screen/cell s 0 9)))))) + + (testing "a cut line keeps the styling of what survives" + (let [s (screen/render-screen (style/render (style/style :bold true) "0123456789") [4 2])] + (is (= "0123" (screen/row-text s 0))) + (is (every? #(:bold? (screen/cell s 0 %)) (range 4)))))) + +(deftest overflow-direction-test + (testing ":top, the default, keeps the last lines" + (let [s (screen/render-screen "one\ntwo\nthree" [10 2])] + (is (= ["two" "three"] (map str/trimr (:grid s)))))) + + (testing ":bottom keeps the first ones, so a title survives" + (let [s (screen/render-screen "one\ntwo\nthree" [10 2] :overflow :bottom)] + (is (= ["one" "two"] (map str/trimr (:grid s))))))) + +(deftest components-on-screen-test + (testing "a table lines its columns up on screen" + (let [tbl (table/table [{:title "Name" :width 6} {:title "N" :width 3}] + [["ada" "1"] ["grace" "22"]] + :cursor 0) + s (screen/render-screen (table/table-view tbl) [20 4])] + (is (= ["Name N" "ada 1" "grace 22"] (take 3 (map str/trimr (:grid s))))) + ;; header is bold, and the cursor row is coloured + (is (true? (:bold? (screen/cell s 0 0)))) + (is (some? (:fg (screen/cell s 1 0)))) + (is (nil? (:fg (screen/cell s 2 0)))))) + + (testing "a viewport shows its window and nothing else" + (let [vp (viewport/viewport (str/join "\n" (map #(str "line " %) (range 1 21))) + :width 10 :height 3) + s (screen/render-screen (viewport/viewport-view vp) [12 4])] + (is (= ["line 1" "line 2" "line 3"] (take 3 (map str/trimr (:grid s))))))) + + (testing "an overlay sits on top of the base, borders intact" + (let [base (style/render (style/style :border border/normal :width 14) "base\nbase\nbase") + panel (style/render (style/style :border border/rounded) "hi") + s (screen/render-screen (overlay/place-overlay base panel 3 1) [20 6])] + ;; the base's own border survives compositing + (is (str/starts-with? (screen/row-text s 0) "┌")) + (is (str/includes? (screen/screen-text s) "╭──╮")) + (is (str/includes? (screen/screen-text s) "│hi│"))))) diff --git a/test-jvm/charm/test/screen.clj b/test-jvm/charm/test/screen.clj new file mode 100644 index 0000000..9766810 --- /dev/null +++ b/test-jvm/charm/test/screen.clj @@ -0,0 +1,103 @@ +(ns charm.test.screen + "Render a frame into an in-memory terminal emulator and read back the screen. + + The other integration tests assert on the escape bytes the renderer wrote, + which is the right level for a question like \"did this OSC reach the + terminal\" but the wrong one for \"what does the user see\": those assertions + break whenever JLine's `Display` changes how it moves the cursor, even though + the screen is identical. + + `org.jline.utils.ScreenTerminal` is a VT emulator. Feeding it the renderer's + output and reading the resulting cells tests the screen instead of the wire. + + This namespace lives under `test-jvm` rather than `test` because + `ScreenTerminal` is not in babashka's image, and a namespace that merely names + it fails to load there - at analysis time, so no runtime guard would help." + (:require + [charm.render.core :as render] + [charm.terminal :as term] + [clojure.string :as str]) + (:import + [java.io ByteArrayInputStream ByteArrayOutputStream] + [java.nio.charset StandardCharsets] + [org.jline.terminal Size TerminalBuilder] + [org.jline.utils ScreenTerminal])) + +(defn- build-terminal + "A terminal that writes to `out` and reports the size we asked for. + + The size has to be given to the builder as well as to the renderer: `Display` + takes its idea of the width from the terminal, and a `Display` that thinks the + screen is wider pads with a cursor-forward, which lands the next line in the + wrong column." + [^ByteArrayOutputStream out cols rows] + (-> (TerminalBuilder/builder) + (.streams (ByteArrayInputStream. (byte-array 0)) out) + (.system false) + (.type "xterm-256color") + (.encoding StandardCharsets/UTF_8) + (.size (Size. cols rows)) + (.build))) + +(defn render-screen + "Render `content` onto a `cols` x `rows` screen and return what it looks like. + + {:grid [\"line 0\" \"line 1\" ...] ; one string per row, space-padded + :cursor [x y] + :cols n :rows n + :cells } ; for `cell` + + Options after the size are passed to `create-renderer`, so `:sanitize`, + `:overflow` and the rest can be exercised." + [content [cols rows] & renderer-opts] + (let [out (ByteArrayOutputStream.) + terminal (build-terminal out cols rows) + renderer (apply render/create-renderer terminal renderer-opts)] + (try + (render/update-size! renderer cols rows) + (render/render! renderer content) + (.flush (.writer terminal)) + (finally + (term/close terminal))) + (let [screen (ScreenTerminal. cols rows) + cells (long-array (* cols rows)) + cursor (int-array 2)] + (.write screen (.toString out "UTF-8")) + (.dump screen cells cursor) + {:grid (vec (for [y (range rows)] + (apply str (for [x (range cols)] + (let [cp (ScreenTerminal/cellCodePoint + (aget cells (+ (* y cols) x)))] + (if (zero? cp) \space (char cp))))))) + :cursor (vec cursor) + :cols cols + :rows rows + :cells cells}))) + +(defn cell + "What is on screen at `row`, `col` - the character and its attributes." + [{:keys [^longs cells cols]} row col] + (let [c (aget cells (+ (* row cols) col)) + cp (ScreenTerminal/cellCodePoint c)] + {:char (if (zero? cp) \space (char cp)) + :bold? (ScreenTerminal/cellBold c) + :italic? (ScreenTerminal/cellItalic c) + :underline? (ScreenTerminal/cellUnderline c) + :inverse? (ScreenTerminal/cellInverse c) + :fg (when (ScreenTerminal/cellHasForeground c) (ScreenTerminal/cellForeground c)) + :bg (when (ScreenTerminal/cellHasBackground c) (ScreenTerminal/cellBackground c))})) + +(defn row-text + "One row of the screen, with trailing blanks removed." + [screen row] + (str/trimr (get (:grid screen) row))) + +(defn screen-text + "The whole screen as one string, trailing blanks and blank rows removed." + [screen] + (->> (:grid screen) + (map str/trimr) + (reverse) + (drop-while str/blank?) + (reverse) + (str/join "\n"))) diff --git a/test/charm/ansi/sanitize_test.clj b/test/charm/ansi/sanitize_test.clj new file mode 100644 index 0000000..816609a --- /dev/null +++ b/test/charm/ansi/sanitize_test.clj @@ -0,0 +1,80 @@ +(ns charm.ansi.sanitize-test + (:require + [clojure.test :refer [deftest is testing]] + [charm.ansi.sanitize :as san])) + +(def ^:private ESC "\u001b") +(def ^:private BEL "\u0007") + +(deftest sanitize-keeps-text-and-styling-test + (testing "plain text is returned as the same object" + (let [s "hello world"] + (is (identical? s (san/sanitize s))))) + + (testing "SGR styling survives, and costs no copy" + (let [s (str ESC "[1;31mred" ESC "[0m")] + (is (identical? s (san/sanitize s))))) + + (testing "newline and tab survive" + (is (= "a\tb\nc" (san/sanitize "a\tb\nc")))) + + (testing "nil is empty" + (is (= "" (san/sanitize nil))) + (is (= "" (san/strip nil))))) + +(deftest sanitize-drops-injected-sequences-test + (testing "OSC 52 cannot reach the clipboard" + (is (= "file.txt" (san/sanitize (str "file" ESC "]52;c;ZXZpbA==" BEL ".txt"))))) + + (testing "OSC 2 cannot rewrite the window title" + (is (= "ab" (san/sanitize (str "a" ESC "]2;PWNED" BEL "b"))))) + + (testing "OSC 8 cannot hyperlink the text" + (is (= "click" (san/sanitize (str ESC "]8;;http://evil" BEL "click" ESC "]8;;" BEL))))) + + (testing "DCS, APC, PM and SOS are dropped, ST-terminated" + (doseq [intro ["P" "_" "^" "X"]] + (is (= "ab" (san/sanitize (str "a" ESC intro "payload" ESC "\\b")))))) + + (testing "an unterminated string sequence swallows its tail, as a terminal does" + (is (= "a" (san/sanitize (str "a" ESC "]52;c;never-closed"))))) + + (testing "non-SGR CSI cannot erase or move" + (is (= "visiblehidden" (san/sanitize (str "visible" ESC "[2K\rhidden")))) + (is (= "ab" (san/sanitize (str "a" ESC "[10;10Hb"))))) + + (testing "a lone ESC and two-character escapes are dropped" + (is (= "a" (san/sanitize (str "a" ESC)))) + (is (= "ab" (san/sanitize (str "a" ESC "cb"))))) + + (testing "C0 other than newline and tab is dropped" + (is (= "ab" (san/sanitize "a\rb"))) + (is (= "ab" (san/sanitize (str "a" BEL "b")))) + (is (= "ab" (san/sanitize "a\u0008b")))) + + (testing "C1 controls are dropped - 0x9b and 0x9d are CSI and OSC" + (is (= "abc" (san/sanitize "a\u009db\u009bc"))))) + +(deftest strip-test + (testing "strip removes styling too" + (is (= "red" (san/strip (str ESC "[31mred" ESC "[0m")))) + (is (= "file.txt" (san/strip (str "file" ESC "]52;c;ZXZpbA==" BEL ".txt"))))) + + (testing "plain text is returned as the same object" + (let [s "hello"] + (is (identical? s (san/strip s)))))) + +(deftest strip-controls-test + (testing "removes every control character, newline and tab included" + (is (= "ab" (san/strip-controls "a\nb"))) + (is (= "ab" (san/strip-controls "a\tb"))) + (is (= "" (san/strip-controls (str ESC BEL))))) + + (testing "a title cannot open a sequence of its own" + (let [title (san/strip-controls (str "hi" ESC "]52;c;ZXZpbA=="))] + (is (not (re-find #"\u001b" title))) + (is (not (re-find #"\u0007" title))))) + + (testing "plain text is returned as the same object" + (let [s "My Window"] + (is (identical? s (san/strip-controls s)))))) diff --git a/test/charm/ansi/width_test.clj b/test/charm/ansi/width_test.clj index 633933a..bc7f2fe 100644 --- a/test/charm/ansi/width_test.clj +++ b/test/charm/ansi/width_test.clj @@ -1,5 +1,6 @@ (ns charm.ansi.width-test (:require [clojure.test :refer [deftest is testing]] + [clojure.string :as str] [charm.ansi.width :as w])) (deftest strip-ansi-test @@ -48,7 +49,21 @@ (testing "nil/empty handling" (is (nil? (w/truncate nil 10))) - (is (= "" (w/truncate "" 10))))) + (is (= "" (w/truncate "" 10)))) + + (testing "keeps the styling of the part that survives" + ;; str on an AttributedString returns plain text, so this used to come back + ;; unstyled - every over-wide styled line lost its color + (let [styled "\033[31mred-and-long\033[0m"] + (is (= 12 (w/string-width styled))) + (let [cut (w/truncate styled 5 :tail "")] + (is (str/includes? cut "\033[31m")) + (is (= "red-a" (w/strip-ansi cut)))))) + + (testing "the tail itself is unstyled" + (let [cut (w/truncate "\033[31m0123456789\033[0m" 6 :tail "...")] + (is (= "012..." (w/strip-ansi cut))) + (is (str/ends-with? cut "..."))))) (deftest pad-test (testing "pad-right" diff --git a/test/charm/components/keybindings_test.clj b/test/charm/components/keybindings_test.clj new file mode 100644 index 0000000..f98e19b --- /dev/null +++ b/test/charm/components/keybindings_test.clj @@ -0,0 +1,61 @@ +(ns charm.components.keybindings-test + "Guards that every default key binding is reachable. + + A binding string that names no key a terminal can actually produce - + \"pgup\" when the event carries :page-up - silently does nothing, and + nothing else in the suite notices." + (:require + [clojure.test :refer [deftest is testing]] + [charm.components.list :as lst] + [charm.components.paginator :as paginator] + [charm.components.table :as table] + [charm.components.text-input :as text-input] + [charm.components.viewport :as viewport] + [charm.input.keys :as keys] + [charm.message :as msg])) + +(def ^:private modifier-combos + (for [ctrl [false true] + alt [false true] + shift [false true]] + {:ctrl ctrl :alt alt :shift shift})) + +(def ^:private key-names + "Every key a real event can carry: the special keys, plus printable runes." + (concat (remove #{:runes :unknown} keys/key-types) + (map #(str (char %)) (range 33 127)))) + +(def ^:private reachable-messages + "One key-press message per key and modifier combination." + (for [key key-names + mods modifier-combos] + (msg/key-press key :ctrl (:ctrl mods) :alt (:alt mods) :shift (:shift mods)))) + +(defn- reachable? + "Is there a real key event that this binding string matches?" + [binding] + (boolean (some #(msg/key-match? % binding) reachable-messages))) + +(def ^:private component-defaults + {"list" @#'lst/default-keys + "table" @#'table/default-keys + "viewport" @#'viewport/default-keys + "paginator" @#'paginator/default-keys + "text-input" @#'text-input/default-keys}) + +(deftest default-bindings-are-reachable-test + (doseq [[component defaults] component-defaults + [action bindings] defaults + binding bindings] + (testing (str component " " action " " (pr-str binding)) + (is (reachable? binding))))) + +(deftest reachable?-catches-unknown-keys-test + (testing "a key name no event carries is not reachable" + (is (not (reachable? "pgupp"))) + (is (not (reachable? "ctrl+nosuchkey")))) + + (testing "the names the components use are reachable" + (is (reachable? "page-up")) + (is (reachable? "ctrl+u")) + (is (reachable? "alt+backspace")))) diff --git a/test/charm/components/spinner_test.clj b/test/charm/components/spinner_test.clj index 662d5dc..4dcdfbb 100644 --- a/test/charm/components/spinner_test.clj +++ b/test/charm/components/spinner_test.clj @@ -101,3 +101,13 @@ (let [s (spinner/spinner :dots :id 42) msg (spinner/tick-msg 99 0)] (is (not (spinner/spinning? s msg)))))) + +(deftest unique-ids-test + (testing "each component gets its own id" + ;; The spinner and the timer route their tick messages back to themselves by + ;; comparing ids, so a collision makes two of them drive each other + (let [ids (repeatedly 500 #(:id (spinner/spinner :dots)))] + (is (= 500 (count (distinct ids)))))) + + (testing "an explicit id is still honoured" + (is (= 42 (:id (spinner/spinner :dots :id 42)))))) diff --git a/test/charm/input/keys_test.clj b/test/charm/input/keys_test.clj index 601867f..409806d 100644 --- a/test/charm/input/keys_test.clj +++ b/test/charm/input/keys_test.clj @@ -83,21 +83,3 @@ (k/make-key {:type :runes :runes "c" :ctrl true}))) (is (= {:type :up :shift true :alt true} (k/make-key {:type :up :shift true :alt true}))))) - -(deftest key-matches?-test - (testing "matches by keyword" - (is (k/key-matches? {:type :enter} :enter)) - (is (not (k/key-matches? {:type :tab} :enter)))) - - (testing "matches by map" - (is (k/key-matches? {:type :runes :runes "c" :ctrl true} - {:type :runes :ctrl true})) - (is (not (k/key-matches? {:type :runes :runes "c"} - {:ctrl true})))) - - (testing "matches by string pattern" - (is (k/key-matches? {:type :runes :runes "c" :ctrl true} "ctrl+c")) - (is (k/key-matches? {:type :runes :runes "x" :alt true} "alt+x")) - (is (k/key-matches? {:type :enter} "enter")) - (is (k/key-matches? {:type :up :shift true} "shift+up")) - (is (not (k/key-matches? {:type :runes :runes "c"} "ctrl+c"))))) diff --git a/test/charm/integration/input_test.clj b/test/charm/integration/input_test.clj index 41888d0..1a73d0a 100644 --- a/test/charm/integration/input_test.clj +++ b/test/charm/integration/input_test.clj @@ -6,7 +6,9 @@ (:require [clojure.test :refer [deftest is testing]] [charm.input.handler :as input] - [charm.input.mouse :as mouse]) + [charm.input.keymap :as km] + [charm.input.mouse :as mouse] + [charm.program]) (:import [java.io ByteArrayOutputStream PipedInputStream PipedOutputStream] [org.jline.terminal TerminalBuilder])) @@ -355,3 +357,38 @@ (testing "returns nil on empty input with timeout" (with-test-terminal [terminal ""] (is (nil? (input/read-event terminal :timeout-ms 10)))))) + +;; --------------------------------------------------------------------------- +;; Bracketed Paste +;; --------------------------------------------------------------------------- + +(deftest read-paste-test + (let [read-paste #'charm.program/read-paste + collect (fn [input] + (with-test-terminal [terminal input] + (let [keymap (km/create-keymap terminal)] + ;; The start marker is consumed by the caller, so the + ;; input here begins with the pasted body + (read-paste terminal keymap (atom true)))))] + (testing "everything up to the end marker is one string" + (is (= "hello world" (collect "hello world\u001b[201~")))) + + (testing "tabs and newlines inside a paste are text, not key presses" + (is (= "a\tb\nc" (collect "a\tb\rc\u001b[201~")))) + + (testing "an unterminated paste returns what arrived" + (is (= "partial" (collect "partial")))) + + (testing "a key that cannot be part of the text does not end the paste" + ;; An arrow key mid-paste is dropped, and the rest still arrives + (is (= "ab" (collect "a\u001b[Ab\u001b[201~")))) + + (testing "an empty paste is an empty string" + (is (= "" (collect "\u001b[201~")))) + + (testing "it gives up when the program stops running" + (with-test-terminal [terminal "never-ends"] + (let [keymap (km/create-keymap terminal) + running? (atom true)] + (future (Thread/sleep 50) (reset! running? false)) + (is (string? (read-paste terminal keymap running?)))))))) diff --git a/test/charm/message_test.clj b/test/charm/message_test.clj index 67ce2c6..f334c58 100644 --- a/test/charm/message_test.clj +++ b/test/charm/message_test.clj @@ -51,6 +51,37 @@ (is (msg/key-match? (msg/key-press "q") :q)) (is (not (msg/key-match? (msg/key-press "a") :q)))) + (testing "key-match? with special keys" + (is (msg/key-match? (msg/key-press :page-up) "page-up")) + (is (msg/key-match? (msg/key-press :escape) :escape)) + (is (not (msg/key-match? (msg/key-press :page-up) "page-down")))) + + (testing "key-match? accepts short spellings" + (is (msg/key-match? (msg/key-press :escape) "esc")) + (is (msg/key-match? (msg/key-press :escape) :esc)) + (is (msg/key-match? (msg/key-press :page-up) "pgup")) + (is (msg/key-match? (msg/key-press :page-down) "pgdown")) + (is (not (msg/key-match? (msg/key-press :page-up) "pgdown")))) + + (testing "key-match? with modifiers" + (is (msg/key-match? (msg/key-press "c" :ctrl true) "ctrl+c")) + (is (msg/key-match? (msg/key-press :page-up :ctrl true) "ctrl+pgup")) + (is (not (msg/key-match? (msg/key-press "c") "ctrl+c")))) + + (testing "a bare key name matches only the unmodified key" + ;; Otherwise an application cannot bind "c" and "ctrl+c" to different things + (is (not (msg/key-match? (msg/key-press "c" :ctrl true) "c"))) + (is (not (msg/key-match? (msg/key-press "x" :alt true) "x"))) + (is (not (msg/key-match? (msg/key-press :tab :shift true) "tab"))) + (is (not (msg/key-match? (msg/key-press :tab :shift true) :tab))) + ;; and still matches when nothing is held + (is (msg/key-match? (msg/key-press "c") "c")) + (is (msg/key-match? (msg/key-press :tab) "tab"))) + + (testing "an uppercase letter carries no shift, so it still matches" + ;; The input layer reports G as a rune without a shift flag + (is (msg/key-match? (msg/key-press "G") "G"))) + (testing "key-match? with non-key-press" (is (not (msg/key-match? (msg/quit) "q"))))) @@ -117,3 +148,14 @@ (is (msg/wheel? (msg/mouse :wheel-up :none 10 20))) (is (msg/wheel? (msg/mouse :wheel-down :none 10 20))) (is (not (msg/wheel? (msg/mouse :press :left 10 20)))))) + +(deftest environment-test + (testing "creates environment message" + (let [m (msg/environment :ansi256 true)] + (is (= :environment (:type m))) + (is (= :ansi256 (:color-profile m))) + (is (true? (:dark-background? m))))) + + (testing "environment? predicate" + (is (msg/environment? (msg/environment :true-color false))) + (is (not (msg/environment? (msg/quit)))))) diff --git a/test/charm/program_test.clj b/test/charm/program_test.clj index 04a6a90..4aa368f 100644 --- a/test/charm/program_test.clj +++ b/test/charm/program_test.clj @@ -1,7 +1,10 @@ (ns charm.program-test (:require [clojure.test :refer [deftest is testing]] [charm.program :as p] - [charm.message :as msg])) + [charm.message :as msg] + [charm.render.core :as render] + [clojure.core.async :as a] + [charm.style.color :as color])) ;; Note: Full program tests require terminal interaction. ;; These tests focus on command and message helper functions. @@ -48,3 +51,318 @@ (is (= :window-size (:type m))) (is (= 80 (:width m))) (is (= 24 (:height m)))))) + +(deftest resolve-color-profile-test + (let [resolve-profile #'p/resolve-color-profile] + (testing "a pinned profile is used as given" + (doseq [profile color/color-profiles] + (is (= profile (resolve-profile profile))))) + + (testing "nil detects from the environment" + (is (contains? color/color-profiles (resolve-profile nil)))) + + (testing "an unknown profile throws, naming the value" + (let [e (is (thrown? clojure.lang.ExceptionInfo (resolve-profile :256color)))] + (is (= :256color (:color-profile (ex-data e)))))))) + +(defn- ctx + "A loop context whose renderer and view are stand-ins - handle-msg! only + touches the renderer for a resize, and never the view." + [update state-atom & {:as overrides}] + (merge {:renderer ::renderer + :update update + :view (constantly "") + :state state-atom + :msg-chan nil + :running? (atom true) + :fps 60 + :ctrl-c :quit} + overrides)) + +(deftest handle-msg-test + (let [handle-msg! #'p/handle-msg!] + (testing "a changed state dirties the frame" + (let [state (atom {:n 0})] + (is (true? (handle-msg! (ctx (fn [st _] [(update st :n inc) nil]) state) + (msg/key-press "j")))) + (is (= {:n 1} @state)))) + + (testing "an unchanged state does not" + (let [state (atom {:n 0})] + (is (false? (handle-msg! (ctx (fn [st _] [st nil]) state) + (msg/key-press "x")))) + (is (= {:n 0} @state)))) + + (testing "an equal but not identical state does" + (let [state (atom {:n 0})] + (is (true? (handle-msg! (ctx (fn [st _] [(into {} st) nil]) state) + (msg/key-press "x")))))) + + (testing "a resize dirties the frame even when the app ignores it" + (let [state (atom {:n 0}) + resized (atom nil)] + (with-redefs [render/update-size! (fn [_ w h] (reset! resized [w h]))] + (is (true? (handle-msg! (ctx (fn [st _] [st nil]) state) + (p/window-size-msg 80 24)))) + (is (= [80 24] @resized))))) + + (testing "ctrl+c quits by default, without reaching update" + (let [running? (atom true) + seen (atom [])] + (is (false? (handle-msg! (ctx (fn [st m] (swap! seen conj m) [st nil]) + (atom {}) :running? running?) + (msg/key-press "c" :ctrl true)))) + (is (false? @running?)) + (is (empty? @seen)))) + + (testing ":ctrl-c :message delivers it to update instead" + (let [running? (atom true) + seen (atom [])] + (handle-msg! (ctx (fn [st m] (swap! seen conj m) [st nil]) + (atom {}) :running? running? :ctrl-c :message) + (msg/key-press "c" :ctrl true)) + (is (true? @running?)) + (is (= 1 (count @seen))) + (is (msg/key-match? (first @seen) "ctrl+c")))) + + (testing "a plain c is not ctrl+c" + (let [running? (atom true)] + (handle-msg! (ctx (fn [st _] [st nil]) (atom {}) :running? running?) + (msg/key-press "c")) + (is (true? @running?)))) + + (testing "quit stops the loop" + (let [running? (atom true)] + (is (false? (handle-msg! (ctx (fn [st _] [st nil]) (atom {}) :running? running?) + (msg/quit)))) + (is (false? @running?)))) + + (testing "an error stops the loop and is rethrown" + (let [running? (atom true) + boom (ex-info "boom" {})] + (is (thrown? clojure.lang.ExceptionInfo + (handle-msg! (ctx (fn [st _] [st nil]) (atom {}) :running? running?) + (msg/error boom)))) + (is (false? @running?)))))) + +(deftest drain-test + (let [drain! #'p/drain!] + (testing "handles the message in hand and everything queued behind it" + (let [state (atom {:seen []}) + msg-chan (a/chan 8) + c (ctx (fn [st m] [(update st :seen conj (:key m)) nil]) state :msg-chan msg-chan)] + (a/>!! msg-chan (msg/key-press "b")) + (a/>!! msg-chan (msg/key-press "c")) + (is (true? (drain! c (msg/key-press "a")))) + (is (= ["a" "b" "c"] (:seen @state))) + ;; Everything was taken + (is (nil? (a/poll! msg-chan))))) + + (testing "one dirty message in a batch dirties the batch" + (let [state (atom {:n 0}) + msg-chan (a/chan 8) + c (ctx (fn [st m] + (if (= "j" (:key m)) [(update st :n inc) nil] [st nil])) + state :msg-chan msg-chan)] + (a/>!! msg-chan (msg/key-press "j")) + (a/>!! msg-chan (msg/key-press "x")) + (is (true? (drain! c (msg/key-press "x")))))) + + (testing "nothing is processed after a quit" + (let [state (atom {:seen []}) + msg-chan (a/chan 8) + c (ctx (fn [st m] [(update st :seen conj (:key m)) nil]) state :msg-chan msg-chan)] + (a/>!! msg-chan (msg/quit)) + (a/>!! msg-chan (msg/key-press "late")) + (drain! c (msg/key-press "a")) + (is (= ["a"] (:seen @state))))) + + (testing "a nil message - the frame tick - is a no-op" + (is (false? (drain! (ctx (fn [st _] [st nil]) (atom {})) nil)))))) + +(deftest run-event-loop-test + (let [run-event-loop! #'p/run-event-loop!] + (testing "a burst of messages costs one render, not one per message" + (let [renders (atom 0) + state (atom {:n 0}) + msg-chan (a/chan 64) + running? (atom true) + c (ctx (fn [st _] [(update st :n inc) nil]) state + :msg-chan msg-chan :running? running? :fps 60)] + (dotimes [_ 50] (a/>!! msg-chan (msg/key-press "j"))) + (a/>!! msg-chan (msg/quit)) + (with-redefs [render/render! (fn [_ _] (swap! renders inc))] + (run-event-loop! c)) + ;; All 50 were handled + (is (= 50 (:n @state))) + ;; ...and coalesced into a single frame + (is (= 1 @renders)))) + + (testing "the frame a program quits on is still drawn" + (let [rendered (atom []) + state (atom {:label "working"}) + msg-chan (a/chan 8) + running? (atom true) + c (ctx (fn [st _] [(assoc st :label "done") nil]) state + :msg-chan msg-chan :running? running? :fps 60 + :view (fn [st] (:label st)))] + ;; The state change and the quit arrive in the same batch, well inside + ;; one frame - the old loop rendered per message, this one must not lose it + (a/>!! msg-chan (msg/key-press "d")) + (a/>!! msg-chan (msg/quit)) + (with-redefs [render/render! (fn [_ content] (swap! rendered conj content))] + (run-event-loop! c)) + (is (= ["done"] @rendered)))) + + (testing "the loop returns when running? is flipped from outside" + (let [state (atom {:n 0}) + msg-chan (a/chan 8) + running? (atom true) + c (ctx (fn [st _] [st nil]) state + :msg-chan msg-chan :running? running? :fps 60) + done (future (run-event-loop! c) :returned)] + (Thread/sleep 30) + (reset! running? false) + (is (= :returned (deref done 2000 :timed-out))))) + + (testing "a dirty frame is still rendered when the next batch changes nothing" + (let [renders (atom 0) + state (atom {:n 0}) + msg-chan (a/chan 8) + running? (atom true) + ;; "j" changes the state, "x" does not + c (ctx (fn [st m] + (if (= "j" (:key m)) [(update st :n inc) nil] [st nil])) + state :msg-chan msg-chan :running? running? :fps 60)] + (a/>!! msg-chan (msg/key-press "j")) + (with-redefs [render/render! (fn [_ _] (swap! renders inc))] + (let [done (future (run-event-loop! c))] + ;; A clean batch arrives before the frame is due + (a/>!! msg-chan (msg/key-press "x")) + (Thread/sleep 100) + (reset! running? false) + (deref done 2000 nil))) + (is (= 1 @renders)))))) + +(deftest execute-cmd-test + (let [execute-cmd! #'p/execute-cmd! + take! (fn [ch] (first (a/alts!! [ch (a/timeout 5000)])))] + (testing "a command's message reaches the channel" + (let [ch (a/chan 4)] + (execute-cmd! (p/cmd (fn [] (msg/key-press "a"))) ch) + (is (= "a" (:key (take! ch)))))) + + (testing "a command that throws becomes an error message" + (let [ch (a/chan 4)] + (execute-cmd! (p/cmd (fn [] (throw (ex-info "boom" {})))) ch) + (is (msg/error? (take! ch))))) + + (testing "a command returning nil sends nothing" + (let [ch (a/chan 4)] + (execute-cmd! (p/cmd (fn [] nil)) ch) + (execute-cmd! (p/cmd (fn [] (msg/key-press "b"))) ch) + ;; Only the second command's message is there + (is (= "b" (:key (take! ch)))))) + + (testing "a sequence runs its commands in order" + (let [ch (a/chan 8)] + (execute-cmd! (p/sequence-cmds (p/cmd (fn [] (msg/key-press "1"))) + (p/cmd (fn [] (msg/key-press "2"))) + (p/cmd (fn [] (msg/key-press "3")))) + ch) + (is (= ["1" "2" "3"] (mapv (fn [_] (:key (take! ch))) (range 3)))))) + + (testing "the color environment reaches a command body" + ;; a/thread conveys the binding frame; a plain Thread would not, and a + ;; command that renders styled text needs it + (let [ch (a/chan 4)] + (binding [color/*color-profile* :ascii + color/*dark-background?* false] + (execute-cmd! (p/cmd (fn [] {:type :probe + :profile color/*color-profile* + :dark? color/*dark-background?*})) + ch)) + (is (= {:type :probe :profile :ascii :dark? false} (take! ch))))) + + (testing "blocking commands do not queue behind core.async's dispatch pool" + ;; Eight threads in that pool, so twenty sleeping commands would take + ;; three times as long if they ran there instead of on a/thread + (let [ch (a/chan 32) + n 20 + sleep-ms 100 + start (System/nanoTime)] + (dotimes [_ n] + (execute-cmd! (p/cmd (fn [] (Thread/sleep sleep-ms) (msg/key-press "x"))) ch)) + (dotimes [_ n] (take! ch)) + (let [elapsed-ms (quot (- (System/nanoTime) start) 1000000)] + (is (< elapsed-ms (* sleep-ms 2)) + (str n " commands sleeping " sleep-ms "ms each took " elapsed-ms "ms"))))))) + +(deftest event->msg-test + (let [event->msg #'p/event->msg] + (testing "typed characters become a key press" + (let [m (event->msg {:type :runes :runes "a"})] + (is (msg/key-press? m)) + (is (= "a" (:key m))))) + + (testing "a named key carries its type as the key" + (is (= :page-up (:key (event->msg {:type :page-up}))))) + + (testing "modifiers are carried through" + (let [m (event->msg {:type :runes :runes "c" :ctrl true})] + (is (true? (:ctrl m))) + (is (false? (:alt m))))) + + (testing "focus and blur" + (is (msg/focus? (event->msg {:type :focus}))) + (is (msg/blur? (event->msg {:type :blur})))) + + (testing "a mouse button press" + (let [m (event->msg {:type :mouse :action :press :button 0 :x 3 :y 4})] + (is (msg/mouse? m)) + (is (= :press (:action m))) + (is (= :left (:button m))) + (is (= [3 4] [(:x m) (:y m)])))) + + (testing "wheel movement replaces the action and reports no button" + (doseq [[code action] {4 :wheel-up 5 :wheel-down 6 :wheel-left 7 :wheel-right}] + (let [m (event->msg {:type :mouse :action :press :button code :x 0 :y 0})] + (is (= action (:action m))) + (is (= :none (:button m)))))) + + (testing "an unknown button is reported as none" + (is (= :none (:button (event->msg {:type :mouse :action :press :button 9 :x 0 :y 0}))))))) + +(deftest input-backoff-test + (let [input-backoff-ms #'p/input-backoff-ms] + (testing "backs off further on each consecutive failure" + (is (= [2 4 8 16 32 64 128 256 500] + (mapv input-backoff-ms (range 1 10))))) + + (testing "and is capped" + (is (= 500 (input-backoff-ms 100)))) + + (testing "it gives up before the backoff would grow unbounded" + (is (< @#'p/max-input-failures 20))))) + +(deftest command-thread-test + (let [execute-cmd! #'p/execute-cmd! + ;; babashka's native image has no virtual threads and io-thread falls + ;; back to ordinary ones there, so the claim below only holds where the + ;; runtime actually provides them + virtual? (a/ (org.jline.terminal.TerminalBuilder/builder) + (.dumb true) + (.streams input output) + (.build)) + opts (apply hash-map opts) + [w h] (:size opts) + renderer (apply r/create-renderer terminal (apply concat (dissoc opts :size)))] + ;; update-size!, not a swap! on the map: Display keeps its own idea of the + ;; width and pads with a cursor-forward when it disagrees + (when w (r/update-size! renderer w h)) + (try + (r/render! renderer content) + (.flush (.writer terminal)) + (.toString output "UTF-8") + (finally + (term/close terminal))))) + +(deftest render-sanitizes-content-test + ;; JLine's own fromAnsi drops OSC, DCS and standard CSI as of 4.4.5, so the + ;; sequences that still reach a terminal unaided are the ones it keeps: ESC c + ;; (RIS, a full terminal reset), carriage return, and private CSI, which it + ;; turns into visible text rather than removing. + (testing "ESC c cannot reset the terminal" + (let [written (render-to-bytes "a\u001bcb")] + (is (re-find #"ab" written)) + (is (not (re-find #"\u001bc" written))))) + + (testing "a carriage return cannot overwrite what was just drawn" + (let [written (render-to-bytes "visible\rhidden")] + (is (not (re-find #"\r" written))))) + + (testing "private CSI is removed, not turned into visible text" + (let [written (render-to-bytes "a\u001b[?1049hb")] + (is (not (re-find #"1049h" written))))) + + (testing ":sanitize false lets the application write its own sequences" + (let [written (render-to-bytes "a\u001bcb" :sanitize false)] + (is (re-find #"\u001bc" written)))) + + (testing "styling still reaches the terminal" + (let [written (render-to-bytes "\u001b[31mred\u001b[0m")] + (is (re-find #"\u001b\[" written)) + (is (re-find #"red" written))))) + +(deftest render-truncation-test + (testing "a line wider than the terminal is cut to the width" + (let [written (render-to-bytes "0123456789" :size [4 1])] + (is (re-find #"0123" written)) + (is (not (re-find #"456789" written))))) + + (testing "a cut line keeps its styling" + ;; The renderer used to truncate through a plain string, which dropped the + ;; styling of every line too wide for the terminal + (let [written (render-to-bytes "\u001b[31m0123456789\u001b[0m" :size [4 1])] + (is (re-find #"\u001b\[31m" written)) + (is (re-find #"0123" written)) + (is (not (re-find #"456789" written))))) + + (testing "a line that fits is untouched" + (let [written (render-to-bytes "\u001b[31mred\u001b[0m" :size [40 1])] + (is (re-find #"\u001b\[31m" written)) + (is (re-find #"red" written)))) + + (testing "more lines than the height keeps the last ones" + (let [written (render-to-bytes "one\ntwo\nthree" :size [40 2])] + (is (not (re-find #"one" written))) + (is (re-find #"three" written)))) + + (testing ":overflow :bottom keeps the first ones instead" + ;; A full-screen view one line too tall should not lose its title + (let [written (render-to-bytes "one\ntwo\nthree" :size [40 2] :overflow :bottom)] + (is (re-find #"one" written)) + (is (not (re-find #"three" written)))))) diff --git a/test/charm/render/screen_test.clj b/test/charm/render/screen_test.clj index 04cfa85..d80dd30 100644 --- a/test/charm/render/screen_test.clj +++ b/test/charm/render/screen_test.clj @@ -25,12 +25,25 @@ (deftest window-title-test (testing "sets window title" - (is (= "\u001b]2;Hello\u0007" (scr/set-window-title "Hello"))))) + (is (= "\u001b]2;Hello\u0007" (scr/set-window-title "Hello")))) + + (testing "a title cannot end the OSC early and open another" + (let [seq-str (scr/set-window-title "hi\u001b]52;c;ZXZpbA==")] + ;; One OSC introducer and one terminator, both ours + (is (= 1 (count (re-seq #"\u001b\]" seq-str)))) + (is (= 1 (count (re-seq #"\u0007" seq-str)))) + (is (= "\u001b]2;hi]52;c;ZXZpbA==\u0007" seq-str))))) (deftest clipboard-test (testing "copies to clipboard using OSC 52" ;; "Hello" in base64 is "SGVsbG8=" - (is (= "\u001b]52;c;SGVsbG8=\u0007" (scr/copy-to-clipboard "Hello"))))) + (is (= "\u001b]52;c;SGVsbG8=\u0007" (scr/copy-to-clipboard "Hello")))) + + (testing "a payload over the terminals' cap throws instead of being truncated" + (let [too-big (apply str (repeat (inc scr/max-clipboard-bytes) "x")) + e (is (thrown? clojure.lang.ExceptionInfo (scr/copy-to-clipboard too-big)))] + (is (= scr/max-clipboard-bytes (:max-bytes (ex-data e)))) + (is (> (:encoded-bytes (ex-data e)) scr/max-clipboard-bytes))))) (deftest content->lines-test (testing "splits on newlines" @@ -39,12 +52,3 @@ (testing "handles CRLF" (is (= ["a" "b"] (scr/content->lines "a\r\nb"))))) -(deftest truncate-line-test - (testing "truncates long lines" - (is (= "hell" (scr/truncate-line "hello" 4)))) - - (testing "leaves short lines alone" - (is (= "hi" (scr/truncate-line "hi" 10)))) - - (testing "handles zero width" - (is (= "hello" (scr/truncate-line "hello" 0))))) diff --git a/test/charm/style/border_test.clj b/test/charm/style/border_test.clj index 3c8d238..40d0dda 100644 --- a/test/charm/style/border_test.clj +++ b/test/charm/style/border_test.clj @@ -60,3 +60,18 @@ (is (= 2 (b/border-height))) ; top and bottom (is (= 1 (b/border-height :top? true :bottom? false))) (is (= 0 (b/border-height :top? false :bottom? false))))) + +(deftest styled-border-keeps-its-characters-test + (testing "a border with a colour keeps its box-drawing characters" + ;; Styling the border used to route its characters through JLine's toAnsi, + ;; which replaced them with ASCII: ┌──┐ arrived as +--+ + (let [result (b/apply-border "hi" :border b/normal :fg {:type :ansi :code 1}) + lines (str/split-lines result)] + (is (str/includes? (first lines) "┌")) + (is (str/includes? (first lines) "┐")) + (is (str/includes? (second lines) "│")) + (is (str/includes? (last lines) "└")) + (is (not (str/includes? result "+"))) + (is (not (str/includes? result "|"))) + ;; and it is actually styled + (is (str/includes? result "\u001b[31m"))))) diff --git a/test/charm/style/color_test.clj b/test/charm/style/color_test.clj index 20c6297..7ea8578 100644 --- a/test/charm/style/color_test.clj +++ b/test/charm/style/color_test.clj @@ -1,6 +1,8 @@ (ns charm.style.color-test (:require [clojure.test :refer [deftest is testing]] - [charm.style.color :as c])) + [clojure.string :as str] + [charm.style.color :as c]) + (:import [org.jline.utils AttributedString AttributedStyle])) (deftest ansi-color-test (testing "creates ANSI colors from numbers" @@ -30,7 +32,60 @@ (testing "parses hex colors without #" (is (= {:type :rgb :r 255 :g 255 :b 255} (c/hex "ffffff"))) - (is (= {:type :rgb :r 0 :g 0 :b 0} (c/hex "000000"))))) + (is (= {:type :rgb :r 0 :g 0 :b 0} (c/hex "000000")))) + + (testing "throws an ex-info naming the value, not a NumberFormatException" + ;; "red" used to surface as: For input string: "re" under radix 16 + (doseq [s ["red" "#ff00" "#ff00001" "#gggggg" ""]] + (let [e (is (thrown? clojure.lang.ExceptionInfo (c/hex s)))] + (is (= s (:color (ex-data e)))))))) + +(deftest adaptive-color-test + (testing "creates adaptive colors" + (is (= {:type :adaptive :light {:type :ansi :code 0} :dark {:type :ansi :code 7}} + (c/adaptive c/black c/white))))) + +(deftest coerce-color-test + (testing "returns nil for nil" + (is (nil? (c/coerce-color nil)))) + + (testing "returns color maps unchanged" + (is (= c/red (c/coerce-color c/red))) + (is (= (c/rgb 1 2 3) (c/coerce-color (c/rgb 1 2 3))))) + + (testing "coerces integers to ANSI 256" + (is (= {:type :ansi256 :code 240} (c/coerce-color 240))) + (is (= {:type :ansi256 :code 0} (c/coerce-color 0)))) + + (testing "coerces ANSI 16 name keywords" + (is (= {:type :ansi :code 1} (c/coerce-color :red))) + (is (= {:type :ansi :code 12} (c/coerce-color :bright-blue)))) + + (testing "coerces hex strings" + (is (= {:type :rgb :r 255 :g 128 :b 0} (c/coerce-color "#ff8000")))) + + (testing "throws on unrecognised values" + (is (thrown? clojure.lang.ExceptionInfo (c/coerce-color :no-such-color))) + (is (thrown? clojure.lang.ExceptionInfo (c/coerce-color 1.5))) + (is (thrown? clojure.lang.ExceptionInfo (c/coerce-color "red"))))) + +(deftest resolve-color-test + (testing "resolves adaptive colors against *dark-background?*" + (let [color (c/adaptive c/black c/white)] + (binding [c/*dark-background?* true] + (is (= c/white (c/resolve-color color)))) + (binding [c/*dark-background?* false] + (is (= c/black (c/resolve-color color)))))) + + (testing "coerces the chosen adaptive variant" + (binding [c/*dark-background?* true] + (is (= {:type :ansi256 :code 254} (c/resolve-color (c/adaptive 236 254)))))) + + (testing "downgrades to *color-profile*" + (binding [c/*color-profile* :ansi256] + (is (= :ansi256 (:type (c/resolve-color (c/rgb 255 0 0)))))) + (binding [c/*color-profile* :ascii] + (is (= {:type :none} (c/resolve-color (c/rgb 255 0 0))))))) (deftest styled-str-test (testing "applies foreground color" @@ -55,17 +110,45 @@ (testing "returns unchanged for no colors" (is (= "x" (c/styled-str "x"))) - (is (= "x" (c/styled-str "x" :fg nil :bg nil))))) - -(deftest rgb->ansi256-test - (testing "converts RGB to ANSI 256" - ;; Pure red should map to color cube - (let [result (c/rgb->ansi256 {:r 255 :g 0 :b 0})] - (is (= :ansi256 (:type result)))) - ;; Gray should map to grayscale ramp - (let [result (c/rgb->ansi256 {:r 128 :g 128 :b 128})] - (is (= :ansi256 (:type result))) - (is (>= (:code result) 232))))) ; Grayscale starts at 232 + (is (= "x" (c/styled-str "x" :fg nil :bg nil)))) + + (testing "coerces shorthand color values" + (is (= "\u001b[38;5;240mx\u001b[0m" (c/styled-str "x" :fg 240))) + (is (= "\u001b[31mx\u001b[0m" (c/styled-str "x" :fg :red)))) + + (testing "renders plain text under the :ascii profile" + (binding [c/*color-profile* :ascii] + (is (= "x" (c/styled-str "x" :fg (c/rgb 255 0 0))))))) + +(deftest downgrade-color-test + (testing ":ansi downgrade preserves hue" + (is (contains? #{c/yellow c/red c/bright-red c/bright-yellow} + (c/downgrade-color (c/rgb 255 128 0) :ansi))) + (is (contains? #{c/yellow c/red c/bright-red c/bright-yellow} + (c/downgrade-color (c/ansi256 214) :ansi)))) + + (testing ":ansi leaves ANSI 16 colors alone" + (is (= c/red (c/downgrade-color c/red :ansi)))) + + (testing ":ansi256 downgrades RGB only" + (is (= :ansi256 (:type (c/downgrade-color (c/rgb 255 128 0) :ansi256)))) + (is (= c/red (c/downgrade-color c/red :ansi256)))) + + (testing ":ansi256 searches the basic 16 entries too" + ;; Olive is exactly entry 3. The old cube-only search returned 142. + (is (= (c/ansi256 3) (c/downgrade-color (c/rgb 128 128 0) :ansi256))) + (is (= (c/ansi256 5) (c/downgrade-color (c/rgb 128 0 128) :ansi256)))) + + (testing ":ansi256 picks the nearest cube entry, not an evenly-spaced guess" + ;; The cube levels are 0/95/135/175/215/255, not multiples of 51: the old + ;; (v*5/255) quantisation rounded 128 up to 175 and returned 214. + (is (= (c/ansi256 208) (c/downgrade-color (c/rgb 255 128 0) :ansi256)))) + + (testing ":ascii drops all color" + (is (= {:type :none} (c/downgrade-color (c/rgb 255 128 0) :ascii)))) + + (testing ":true-color passes through" + (is (= (c/rgb 255 128 0) (c/downgrade-color (c/rgb 255 128 0) :true-color))))) (deftest predefined-colors-test (testing "predefined colors are available" @@ -74,3 +157,42 @@ (is (= {:type :ansi :code 2} c/green)) (is (= {:type :ansi :code 7} c/white)) (is (= {:type :ansi :code 9} c/bright-red)))) + +(deftest line-drawing-characters-test + ;; JLine's toAnsi does two jobs: emit escapes, and rewrite characters it thinks + ;; the terminal cannot show. With no Terminal it assumes the worst, so styling + ;; text used to turn ┌──┐ into +--+ while unstyled text came through intact. + (testing "styled-str keeps line-drawing characters" + (let [out (c/styled-str "┌─┤│├─┐" :fg c/red)] + (is (str/includes? out "┌─┤│├─┐")) + (is (not (str/includes? out "+"))) + (is (not (str/includes? out "|"))))) + + (testing "styled-str keeps other non-ASCII too" + (is (str/includes? (c/styled-str "héllo 你好 ✓ →" :fg c/red) "héllo 你好 ✓ →"))) + + (testing "an unstyled string is returned unchanged" + (is (= "┌──┐" (c/styled-str "┌──┐")))) + + (testing "attributed->ansi emits exactly what JLine would, for ASCII" + ;; The escapes are read off a probe, so they must not drift from JLine's own + (doseq [style [AttributedStyle/DEFAULT + (.bold AttributedStyle/DEFAULT) + (c/apply-color-fg AttributedStyle/DEFAULT c/red) + (c/apply-color-bg AttributedStyle/DEFAULT c/blue) + (c/apply-color-fg AttributedStyle/DEFAULT (c/rgb 255 128 0)) + (-> AttributedStyle/DEFAULT (.bold) (.underline) + (c/apply-color-fg c/red) (c/apply-color-bg c/white))]] + (let [as (AttributedString. "plain ASCII text" style)] + (is (= (.toAnsi as) (c/attributed->ansi as)) + (str "drifted for " style))))) + + (testing "attributed->ansi keeps one run per stretch of styling" + (let [mixed (AttributedString/fromAnsi "\u001b[31mred\u001b[0m│\u001b[32mgreen\u001b[0m") + out (c/attributed->ansi mixed)] + (is (str/includes? out "│")) + (is (str/includes? out "\u001b[31m")) + (is (str/includes? out "\u001b[32m")))) + + (testing "an empty string survives" + (is (= "" (c/attributed->ansi (AttributedString. "")))))) diff --git a/test/charm/style/core_test.clj b/test/charm/style/core_test.clj index 6cf9068..0ff5947 100644 --- a/test/charm/style/core_test.clj +++ b/test/charm/style/core_test.clj @@ -5,6 +5,21 @@ [charm.style.border :as b] [clojure.string :as str])) +(deftest color-shorthand-render-test + (testing "integer :fg renders as ANSI 256" + (is (str/includes? (s/render (s/style :fg 240) "hi") "\u001b[38;5;240m"))) + + (testing "keyword and hex string colors render" + (is (str/includes? (s/render (s/style :fg :red) "hi") "\u001b[31m")) + (is (str/includes? (s/render (s/style :fg "#ff0000") "hi") "\u001b["))) + + (testing "adaptive colors resolve against the background" + (let [st (s/style :fg (s/adaptive c/black c/white))] + (binding [c/*dark-background?* true] + (is (str/includes? (s/render st "hi") "\u001b[37m"))) + (binding [c/*dark-background?* false] + (is (str/includes? (s/render st "hi") "\u001b[30m")))))) + (deftest style-creation-test (testing "creates style with defaults" (let [st (s/style)] @@ -16,7 +31,13 @@ (testing "creates style with options" (let [st (s/style :fg c/red :bold true)] (is (= c/red (:fg st))) - (is (true? (:bold st)))))) + (is (true? (:bold st))))) + + (testing "normalizes a bare padding or margin value" + (is (= [3] (:padding (s/style :padding 3)))) + (is (= [3] (:margin (s/style :margin 3)))) + (is (= [1 2] (:padding (s/style :padding [1 2])))) + (is (nil? (:padding (s/style)))))) (deftest style-modifiers-test (testing "with-fg sets foreground" @@ -52,10 +73,22 @@ (let [result (s/render (s/style :bold true) "hello")] (is (str/includes? result "\u001b[1m")))) + (testing "renders every documented text attribute" + (doseq [[attr code] {:bold "1" :faint "2" :italic "3" :underline "4" + :blink "5" :reverse "7" :strikethrough "9"}] + (is (str/includes? (s/render (s/style attr true) "hello") + (str "\u001b[" code "m")) + (str attr " should emit SGR " code)))) + (testing "renders with padding" (let [result (s/render (s/style :padding [0 2 0 2]) "hi")] (is (str/includes? result " hi ")))) + (testing "renders with a bare padding value" + (let [lines (str/split-lines (s/render (s/style :padding 1) "hi"))] + (is (= 3 (count lines))) + (is (str/includes? (second lines) " hi ")))) + (testing "renders with border" (let [result (s/render (s/style :border b/normal) "hi") lines (str/split-lines result)] @@ -96,6 +129,9 @@ (is (= 4 w)) ; 2 left + 2 right (is (= 2 h)))) ; 1 top + 1 bottom + (testing "calculates frame size with a bare padding value" + (is (= [6 6] (s/frame-size (s/style :padding 3))))) + (testing "calculates frame size with margin" (let [[w h] (s/frame-size (s/style :margin [1]))] (is (= 2 w)) ; 1 left + 1 right @@ -114,3 +150,32 @@ (is (= 8 w)) ;; padding: 1+1, border: 1+1, margin: 1+1 = 6 (is (= 6 h))))) + +(deftest merge-style-test + (let [base (s/style :fg c/red :padding [0 1] :width 20)] + (testing "changes only the named options" + (let [variant (s/merge-style base :fg c/blue :bold true)] + (is (= c/blue (:fg variant))) + (is (true? (:bold variant))) + ;; inherited, not reset to the constructor default + (is (= [0 1] (:padding variant))) + (is (= 20 (:width variant))))) + + (testing "plain merge of two styles is what this avoids" + ;; (merge base (style :bold true)) would overwrite :fg with nil + (is (nil? (:fg (merge base (s/style :bold true))))) + (is (= c/red (:fg (s/merge-style base :bold true))))) + + (testing "an option can be turned back off" + (let [bolded (s/merge-style base :bold true)] + (is (false? (:bold (s/merge-style bolded :bold false)))))) + + (testing "a bare padding or margin value is normalized, as in style" + (is (= [2] (:padding (s/merge-style base :padding 2)))) + (is (= [3] (:margin (s/merge-style base :margin 3))))) + + (testing "with no options it is a copy" + (is (= base (s/merge-style base)))) + + (testing "the result renders" + (is (str/includes? (s/render (s/merge-style base :fg c/blue) "hi") "hi"))))) diff --git a/test/charm/style/overlay_test.clj b/test/charm/style/overlay_test.clj index 9fe10c1..e9c26a2 100644 --- a/test/charm/style/overlay_test.clj +++ b/test/charm/style/overlay_test.clj @@ -85,3 +85,16 @@ lines (str/split-lines result)] ;; x=(9-3)/2=3, y=(5-1)/2=2 (is (str/includes? (nth lines 2) "XXX"))))) + +(deftest composited-lines-keep-their-characters-test + (testing "compositing does not rewrite box-drawing characters" + ;; Every composited line goes through an AttributedStringBuilder, whose + ;; toAnsi used to turn the base's │ and ─ into | and - + (let [base (str/join "\n" (repeat 4 "│ ──── │")) + panel "╭─╮\n│x│\n╰─╯" + out (overlay/place-overlay base panel 3 1)] + (is (str/includes? out "│")) + (is (str/includes? out "─")) + (is (str/includes? out "╭")) + (is (not (str/includes? out "|"))) + (is (not (str/includes? out "-")))))) diff --git a/test/charm/terminal_test.clj b/test/charm/terminal_test.clj index 528727b..523878e 100644 --- a/test/charm/terminal_test.clj +++ b/test/charm/terminal_test.clj @@ -36,6 +36,27 @@ (finally (term/close t)))))) +(deftest dark-color?-test + (testing "dark colors are detected by luminance" + (is (term/dark-color? 0x000000)) + (is (term/dark-color? 0x1e1e2e)) + (is (not (term/dark-color? 0xffffff))) + (is (not (term/dark-color? 0xfafafa)))) + + (testing "luminance weights green heaviest" + (is (not (term/dark-color? 0x00ff00))) + (is (term/dark-color? 0x0000ff)))) + +(deftest dark-background?-test + (testing "returns a boolean, true when the background is unknown" + ;; In non-interactive environments JLine creates a dumb terminal, + ;; which cannot answer the OSC 11 background query. + (let [t (term/create-terminal)] + (try + (is (boolean? (term/dark-background? t))) + (finally + (term/close t)))))) + (deftest reader-writer-test (testing "get-reader returns non-nil" (let [t (term/create-terminal)] @@ -50,3 +71,27 @@ (is (some? (term/get-writer t))) (finally (term/close t)))))) + +(deftest signal-handling-test + (testing "handle-signal returns the handler it replaced, so it can be put back" + (let [fired (atom 0) + original (term/handle-signal :winch #(swap! fired inc)) + ours (term/handle-signal :winch #(swap! fired inc))] + ;; The second call hands back the handler the first one installed + (is (some? ours)) + (is (not= original ours)) + (term/restore-signal! :winch original) + ;; Restoring put the original back, so it comes round again + (is (= original (term/handle-signal :winch #(swap! fired inc)))) + (term/restore-signal! :winch original))) + + (testing "restore-signal! tolerates a nil handler" + (is (nil? (term/restore-signal! :int nil)))) + + (testing "every signal name is one this platform accepts" + (is (= #{:int :quit :tstp :cont :winch} (set (keys term/signals)))) + ;; JLine throws for a signal the platform does not have - INFO, for one, + ;; is BSD-only - so registering each in turn is the check that matters + (doseq [signal (keys term/signals)] + (let [previous (term/handle-signal signal (fn []))] + (is (nil? (term/restore-signal! signal previous)))))))