diff --git a/.github/actions/setup-nix/action.yml b/.github/actions/setup-nix/action.yml new file mode 100644 index 0000000..20a0315 --- /dev/null +++ b/.github/actions/setup-nix/action.yml @@ -0,0 +1,63 @@ +name: Set up Nix with Cachix +description: >- + Install Nix with flakes enabled and configure Cachix. Pushes to the binary + cache only on non-pull_request events that carry an auth token; every other + run (including fork pull requests) is pull-only. + +inputs: + cachix-cache: + description: Cachix cache name. When empty, Cachix is not configured at all. + required: false + default: "" + cachix-auth-token: + description: >- + Cachix auth token. When empty — or on pull_request events — the cache is + configured pull-only so untrusted runs can never push. + required: false + default: "" + github-token: + description: GitHub token handed to the Nix installer to raise API rate limits. + required: true + +runs: + using: composite + steps: + - name: Install Nix + uses: cachix/install-nix-action@630ae543ea3a38a9a4166f03376c02c50f408342 # v31 + with: + github_access_token: ${{ inputs.github-token }} + extra_nix_config: | + experimental-features = nix-command flakes + + # Decide push vs pull-only once, off the event name and token presence, + # so both Cachix steps share a single source of truth. The token is read + # from the environment rather than interpolated into the script body. + - name: Resolve Cachix mode + id: cachix-mode + shell: bash + env: + CACHIX_AUTH_TOKEN: ${{ inputs.cachix-auth-token }} + EVENT_NAME: ${{ github.event_name }} + run: | + set -euo pipefail + push=false + if [[ -n "$CACHIX_AUTH_TOKEN" && "$EVENT_NAME" != "pull_request" ]]; then + push=true + fi + printf 'push=%s\n' "$push" >> "$GITHUB_OUTPUT" + + - name: Configure Cachix (pull-only) + if: ${{ inputs.cachix-cache != '' && steps.cachix-mode.outputs.push != 'true' }} + uses: cachix/cachix-action@5f2d7c5294214f71b873db4b969586b980625e71 # v17 + with: + name: ${{ inputs.cachix-cache }} + extraPullNames: nix-community + skipPush: true + + - name: Configure Cachix (push-enabled) + if: ${{ inputs.cachix-cache != '' && steps.cachix-mode.outputs.push == 'true' }} + uses: cachix/cachix-action@5f2d7c5294214f71b873db4b969586b980625e71 # v17 + with: + name: ${{ inputs.cachix-cache }} + authToken: ${{ inputs.cachix-auth-token }} + extraPullNames: nix-community diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 0522415..7995111 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -15,31 +15,37 @@ permissions: contents: read jobs: - verify: - name: verify (${{ matrix.os }}) - runs-on: ${{ matrix.os }} + nix: + name: nix flake check (${{ matrix.system }}) strategy: fail-fast: false matrix: - os: [ubuntu-latest, macos-latest] + include: + - system: x86_64-linux + runner: ubuntu-latest + - system: aarch64-darwin + runner: macos-latest + runs-on: ${{ matrix.runner }} + timeout-minutes: 30 steps: - uses: actions/checkout@v4 - with: - submodules: recursive - - - name: Install SBCL (Linux) - if: runner.os == 'Linux' - run: sudo apt-get update && sudo apt-get install -y sbcl - - - name: Install SBCL (macOS) - if: runner.os == 'macOS' - run: brew install sbcl - - name: Report SBCL version - run: sbcl --version - - - name: Run full verification gate - run: sbcl --script scripts/verify.lisp + - name: Set up Nix with Cachix + uses: ./.github/actions/setup-nix + with: + cachix-cache: ${{ vars.CACHIX_CACHE }} + cachix-auth-token: ${{ secrets.CACHIX_AUTH_TOKEN }} + github-token: ${{ secrets.GITHUB_TOKEN }} + + # Runs the hermetic test/paredit-lint/formatting checks from flake.nix + # (cl-prolog and cl-weave come from flake inputs, not a vendored copy). + # --all-systems evaluates every entry in flake.nix's `systems` list, not + # just the runner's own: without it a platform this flake advertises but + # can no longer evaluate (as x86_64-darwin became once nixpkgs 26.11 + # dropped it) stays invisible to CI on both matrix runners. Foreign + # systems are evaluated, not built, so this stays cheap. + - name: Run flake checks + run: nix flake check --all-systems --print-build-logs - name: Check diff hygiene run: git diff --check @@ -47,47 +53,61 @@ jobs: coverage: name: coverage runs-on: ubuntu-latest + timeout-minutes: 15 steps: - uses: actions/checkout@v4 - with: - submodules: recursive - - name: Install SBCL - run: sudo apt-get update && sudo apt-get install -y sbcl + - name: Set up Nix with Cachix + uses: ./.github/actions/setup-nix + with: + cachix-cache: ${{ vars.CACHIX_CACHE }} + cachix-auth-token: ${{ secrets.CACHIX_AUTH_TOKEN }} + github-token: ${{ secrets.GITHUB_TOKEN }} - name: Generate coverage report - run: sbcl --script scripts/coverage.lisp + run: | + set -euo pipefail + nix build .#coverage-report --print-build-logs + cp -rL result coverage-report - name: Upload coverage report uses: actions/upload-artifact@v4 with: name: coverage-report - path: coverage/ + path: coverage-report/ if-no-files-found: error - # Best-effort: exercises contrib/, which pulls Quicklisp plus the - # vendor/ git submodules (nerima-lisp/cl-prolog, nerima-lisp/cl-weave). Kept - # separate from `verify` and allowed to fail so that submodule/network - # flakiness never blocks a core merge, per contrib/README.md's policy - # that contrib is opt-in and isolated from the core build and CI. + # Best-effort: exercises contrib/, which pulls Quicklisp (for clweb) on top + # of cl-prolog/cl-weave from this flake's Nix inputs. Kept separate from + # `nix` and allowed to fail so that Quicklisp/network flakiness never + # blocks a core merge, per contrib/README.md's policy that contrib is + # opt-in and isolated from the core build and CI. contrib: name: contrib (opt-in, best-effort) runs-on: ubuntu-latest continue-on-error: true + timeout-minutes: 15 steps: - uses: actions/checkout@v4 - with: - submodules: recursive - - name: Install SBCL - run: sudo apt-get update && sudo apt-get install -y sbcl + - name: Set up Nix with Cachix + uses: ./.github/actions/setup-nix + with: + cachix-cache: ${{ vars.CACHIX_CACHE }} + cachix-auth-token: ${{ secrets.CACHIX_AUTH_TOKEN }} + github-token: ${{ secrets.GITHUB_TOKEN }} - name: Install Quicklisp run: | - curl -fsSL -o /tmp/quicklisp.lisp https://beta.quicklisp.org/quicklisp.lisp - sbcl --non-interactive \ - --load /tmp/quicklisp.lisp \ - --eval '(quicklisp-quickstart:install)' - + set -euo pipefail + nix develop --command bash -c ' + curl -fsSL -o /tmp/quicklisp.lisp https://beta.quicklisp.org/quicklisp.lisp + sbcl --non-interactive \ + --load /tmp/quicklisp.lisp \ + --eval "(quicklisp-quickstart:install)" + ' + + # `nix develop` puts cl-prolog/cl-weave from this flake's inputs on + # CL_SOURCE_REGISTRY (see flake.nix devShells.default.shellHook). - name: Run contrib verification - run: sbcl --script contrib/verify-contrib.lisp + run: nix develop --command sbcl --script contrib/verify-contrib.lisp diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml index f73f313..d7747c6 100644 --- a/.github/workflows/docs.yml +++ b/.github/workflows/docs.yml @@ -5,6 +5,8 @@ on: branches: [main] paths: - "docs/**" + - "flake.nix" + - "flake.lock" - ".github/workflows/docs.yml" workflow_dispatch: @@ -23,24 +25,31 @@ jobs: contents: read steps: - name: Checkout - uses: actions/checkout@v4 - - - name: Set up Python - uses: actions/setup-python@v5 + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v4 with: - python-version: "3.12" + persist-credentials: false - - name: Install MkDocs Material - run: pip install --disable-pip-version-check mkdocs-material + - name: Set up Nix with Cachix + uses: ./.github/actions/setup-nix + with: + cachix-cache: ${{ vars.CACHIX_CACHE }} + # Never hand the push token to pull_request runs (local `./` action is + # resolved from the PR head). Empty token => pull-only. + cachix-auth-token: ${{ github.event_name != 'pull_request' && secrets.CACHIX_AUTH_TOKEN || '' }} + github-token: ${{ secrets.GITHUB_TOKEN }} - name: Build documentation - timeout-minutes: 5 - run: mkdocs build --strict --config-file docs/mkdocs.yml + timeout-minutes: 10 + run: | + set -euo pipefail + nix build .#docs --print-build-logs + cp -rL result public + chmod -R u+w public - - uses: actions/configure-pages@v5 - - uses: actions/upload-pages-artifact@v3 + - uses: actions/configure-pages@45bfe0192ca1faeb007ade9deae92b16b8254a0d # v6.0.0 + - uses: actions/upload-pages-artifact@fc324d3547104276b827a68afc52ff2a11cc49c9 # v5.0.0 with: - path: site + path: public deploy: name: Deploy documentation @@ -55,4 +64,4 @@ jobs: url: ${{ steps.deployment.outputs.page_url }} steps: - id: deployment - uses: actions/deploy-pages@v4 + uses: actions/deploy-pages@cd2ce8fcbc39b97be8ca5fce6e763baed58fa128 # v5.0.0 diff --git a/.gitignore b/.gitignore index d3a6240..46f5f4c 100644 --- a/.gitignore +++ b/.gitignore @@ -26,6 +26,10 @@ system-index.txt cl-tty-kit !cl-tty-kit.asd +# Nix build result symlinks (`nix build`, `nix build .#`) +/result +/result-* + # Editor and OS noise *~ \#*\# diff --git a/.gitmodules b/.gitmodules deleted file mode 100644 index 989d1a7..0000000 --- a/.gitmodules +++ /dev/null @@ -1,6 +0,0 @@ -[submodule "vendor/cl-prolog"] - path = vendor/cl-prolog - url = https://github.com/nerima-lisp/cl-prolog.git -[submodule "vendor/cl-weave"] - path = vendor/cl-weave - url = https://github.com/nerima-lisp/cl-weave.git diff --git a/CHANGELOG.md b/CHANGELOG.md index f15a0e8..0e2271c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,283 @@ ## Unreleased +## 1.0.0 - 2026-07-26 + +First stable release. The public API -- the symbols exported from the +`cl-tty-kit` package, enumerated in `README.md`'s "API Overview" and asserted +against the live package by `t/package-introspection.lisp` -- is now covered by +semantic versioning. See the new "API stability" section in `README.md` for +exactly what the 1.x guarantee does and does not cover. No behavior changed +between 0.6.0 and this release beyond the entries below; 1.0.0 is a statement +about the stability of a surface that had already settled, not a rewrite. + +- **fix:** `flake.nix` advertised `x86_64-darwin` in its `systems` list, but + nixpkgs 26.11 (which the `nixos-unstable` input now tracks) dropped support + for that platform outright -- so every flake output for it failed to + *evaluate*, not merely to build. CI never saw this because plain `nix flake + check` only evaluates outputs for the runner's own system, and neither + matrix runner is `x86_64-darwin`. Removed the platform from `systems`, and + changed `.github/workflows/ci.yml` to run `nix flake check --all-systems` so + the gate now covers every platform the flake claims rather than only the two + it happens to run on. Foreign systems are evaluated, not built, so the check + stays cheap. Supported platforms are now `x86_64-linux`, `aarch64-linux`, + and `aarch64-darwin` +- **fix:** `t/screen.lisp` ended with a trailing blank line, which + `git diff --check` -- step 3 of `RELEASING.md`'s own checklist and a CI step + in `ci.yml` -- reports as a defect. It was introduced by the `t/screen.lisp` + split below and would have failed the release gate +- `flake.nix`: give `apps.{default,test,verify,coverage}` a `meta.description`. + These are the entry points `README.md`, `docs/src/installation.md`, and + `RELEASING.md` all point users at, and they are what `nix flake show` + renders; `nix flake check` warned about all four on every system +- **fix:** `t/pty.lisp` assumed every PTY child could resolve a binary on + `PATH`, which is false: `make-pty` forwards `:environment` straight to + `sb-ext:run-program`, where `nil` means an *empty* environment rather than + an inherited one, so a child spawned with the default has no `PATH` at all + and `/bin/sh` falls back to a compiled-in default. That default contains + `sleep` on macOS and does not inside the Nix build sandbox, so two cases + passed locally and failed only in CI -- and they failed *differently* on + consecutive runs, which is what made the shape of the bug visible: + - the SIGTERM case spawned `/bin/sleep`, an absolute path the sandbox does + not provide at all (only `/bin/sh` and the Nix store exist), and failed + with a `:SPAWN` `pty-operation-failed`. It now spawns + `/bin/sh -c 'exec sleep 5'` with the inherited environment, so `PATH` + resolves coreutils' `sleep`; `exec` matters, since it replaces the shell + so nothing is left reading stdin, which is the whole point of the case. + - the read case used `printf hello; sleep 0.05`, where the `sleep` existed + only to hold the child alive while the parent drained the master side. + With `sleep` unavailable the shell exited immediately, and the test + became a race the parent could lose -- a dead child makes the next + master-side read fail with `EIO` instead of returning `hello`. This was + a **pre-existing latent flake**, not a new regression; the `/bin/sleep` + failure had simply been masking it by aborting the suite first. Now + `printf hello; read ignored`, both shell builtins and so needing no + `PATH`, with the child blocking on stdin until `close-pty` closes the + master and it sees EOF. The race is gone rather than widened. + A new `inherited-environment` helper carries the explanation, and both + copies of the quality-gate doc gain a section on the macOS sandbox gap plus + the `nix build --option sandbox true .#checks.aarch64-darwin.test` command + that reproduces CI locally. +- docs: `CHANGELOG.md` carried the `nerima-lisp` org adoption survey entry + twice, verbatim. Removed the duplicate +- docs: state the stability contract explicitly, since a 1.0 is a promise and + a promise has to be written down. `README.md` and the documentation site's + landing page each gain an "API stability" section; `RELEASING.md` and + `docs/src/release-process.md` gain "What the version guarantees" / "What + requires a 2.0". All four name the same stable surface -- the symbols + exported from the `cl-tty-kit` package, plus decoded-event shape and the + `tty-kit-error` hierarchy -- and the same exclusions: `%`-prefixed + internals, `contrib/`, the build/CI plumbing, and `render-diff`'s exact + byte sequence (bounded by `t/properties.lisp`'s visible-result property, + not by a fixed transcript) + +- extract `examples/event-loop.lisp`'s continuation-passing-style chunk + driver (`%chunk-source`/`%decode-chunks-cps`) into `examples/bootstrap.lisp`, + shared by every example that decodes a fixed chunk list, and switch + `examples/streaming-paste.lisp` to it too -- it had the exact same + batch-`dolist` shape `event-loop.lisp` had before this driver existed. A + second, independent application of the same CPS restructuring, not a + one-off +- add `contrib/cl-tty-kit-cl-parser-kit-csi-grammar`, adopting + [`nerima-lisp/cl-parser-kit`](https://github.com/nerima-lisp/cl-parser-kit) + as a new `flake.nix` input: a second, independent declarative recognizer + for the ECMA-48 CSI byte-class grammar, built on cl-parser-kit's + `seq`/`many`/`type-token` parser combinators rather than + `cl-tty-kit-cl-prolog-csi-grammar`'s cl-prolog DCG rules. Wired into + `contrib/verify-contrib.lisp`, which now cross-checks both grammars agree + on every case in `t/sgr-prolog-oracle.lisp`'s existing scenario set -- the + same differential-testing shape that oracle already uses against the + hand-written decoder, now applied a second time between two independent + declarative specifications. The 22 other `nerima-lisp` repositories + surveyed earlier this cycle had no fit against this project's actual + needs (a live PTY session, no free-text grammar on cl-tty-kit's own hot + path); this one does, as a `contrib/`-only opt-in addition, not a core + dependency +- close the last two real branch-coverage gaps in `src/`: `t/pty.lisp` adds a + `/bin/sleep` case for `close-pty`, since a `/bin/sh` child reads stdin and + therefore always dies from the stream close alone (SIGPIPE/EOF) before + `%close-pty-process` ever needs to send a real signal -- every existing + real-process test silently skipped `%terminate-pty-process`'s SIGTERM path + entirely; and a case rigging a real stream's `SB-SYS:FD-STREAM-FD` to `-1` + (restored before closing, so the real descriptor is never leaked) for + `pty-fd`'s "negative fd is not a valid descriptor" guard, which no natural + stream state reaches. A systematic re-scan of every `src/` coverage report + -- filtered to only lines inside a `defun`/`defmacro` body, so the + extensive `&key`/`defstruct`/type-declaration artifact noise documented in + `docs/QUALITY-GATES.md` doesn't hide a real one -- now finds zero + remaining branch gaps in any function body across all of `src/`; every + reported line left uncovered is one of those documented instrumentation + artifacts. `src/` moves to 95.36% expr / 96.0% branch +- `t/mouse.lisp`: collapse `%test-mouse-basic`/`%test-mouse-wheel-and-motion`/ + `%test-mouse-modifiers` (14 near-identical `%mouse-is` call sites across + three functions) into one `+mouse-decode-cases+` data table plus a single + `do-test-case-bind`-driven `%test-mouse-decode-cases`, reusing this + project's existing table-driven test macro (`t/suite.lisp`) rather than + inventing a new one. Also strengthens the assertion: every case now checks + `consumed` against the actual report length instead of only the first case + hardcoding it +- close four more real coverage gaps found by a full audit of every + remaining `src/` branch/line miss: `format-sparkline`'s and + `format-table`'s "argument is not a sequence/list of rows" validation + (`src/format.lisp`), `decode-color-report`'s "second `/` channel + separator missing" fallback (`src/keys-decode.lisp`), and + `%sb-posix-symbol`'s SB-POSIX-symbol-renamed-or-removed portability guard + (`src/raw-mode-sbcl.lisp`) were all real, previously-untested error/decline + paths -- `src/` moves from 94.8%/94.8% to 95.35%/95.72% (expr/branch). + Document, in both copies of the quality-gate doc, a second confirmed + `sb-cover` instrumentation artifact beyond top-level data definitions: + `&key`/`&optional` default-value init-forms in an ordinary `defun` report + as permanently uncovered even when the function is called without that + argument (verified against `src/cell.lisp`'s `make-cell`, whose `char` + default `%blank-cell` calls on every blank screen cell in this codebase) +- **fix a regression this session itself introduced**: an earlier + `git checkout` used to recover from a botched mechanical edit (see the + `%esc` helper entry below) silently reverted `t/keys.lisp` and + `t/input.lisp` past two test cases that predated this session and were + never committed -- the four-C0-control-key decode cases and both + `:normalize-paste-line-endings` cases. Both source features were already + correct and already documented in this file and `docs/src/input-decoding.md`; + only their tests were lost, silently dropping + `src/input-decode-internals.lisp`'s branch coverage from ~98% to ~80% + without any test failure to signal it. Restored both, verified against the + original diff seen at the start of this session +- survey all 23 repositories in the `nerima-lisp` GitHub org for adoption + candidates beyond the three already in use (`cl-prolog`, `cl-weave`, + `paredit-cli`). `cl-process-kit` ("process execution toolkit with timeout + and signal escalation") looked closest to `src/pty.lisp`'s + `%run-program-with-pty-retry`/`%terminate-pty-process` on paper, but its + API (`run`/`spawn`/`communicate`, modeled on `subprocess.run`) is for + running a command to completion and capturing output, with no PTY + allocation -- it solves a different problem than a live, indefinitely-held + interactive PTY session, so adopting it would need a bolted-on adapter + rather than a direct fit. `cl-boundary-kit` (swappable protocol/test-double + boundaries) could model PTY/raw-mode as a boundary, but `t/pty.lisp` + already tests against real pipes and a real `/bin/sh` process, which + exercises actual OS behavior more rigorously than a fake would; adopting it + would mean a speculative architecture change for no clear gain over the + existing file-based pure/OS-facing split the README already documents. The + rest of the org (compiler backends, a JSON reader, a shell, a logging + toolkit, ...) has no surface overlapping this project's public API. No new + dependency added +- docs: add a `packages.docs` output to `flake.nix` (`nix build .#docs`), a + hermetic, fully offline MkDocs (Material) build in `--strict` mode -- + mirroring `nerima-lisp/cl-weave`'s own `mkDocs` derivation. Rewrite + `.github/workflows/docs.yml` around it: the `build` job now uses + `./.github/actions/setup-nix` and `nix build .#docs` instead of a bare + `pip install mkdocs-material` + `mkdocs build`, and the + `configure-pages`/`upload-pages-artifact`/`deploy-pages`/`checkout` actions + are SHA-pinned. `docs/src/contributing.md` and `docs/src/release-process.md` + are updated to match; there is no more `pip`/`mkdocs serve` local-preview + path -- `nix build .#docs` plus opening `result/index.html` is now the only + documented way to build and review the site +- docs: the root README's "Input decoding" section was missing the + `:normalize-paste-line-endings` option documented below and already covered + in `docs/src/input-decoding.md`; add the matching example and cross-link. + Also, `README.md`'s "Testing" section and both copies of the contributing + guide (`CONTRIBUTING.md`, `docs/src/contributing.md`) presented + `sbcl --script scripts/*.lisp` as runnable from any shell -- true while the + submodules provided `cl-prolog`/`cl-weave` on `CL_SOURCE_REGISTRY`, no + longer true now that only `nix develop` (or an equivalent `nix run + .#test`/`.#verify`/`.#coverage`) does; each now says so +- input decoding: recognize the four C0 controls above the letter range that a + US keyboard reaches via Ctrl plus punctuation -- `Ctrl-\` (28), `Ctrl-]` + (29), `Ctrl-^` (30), and `Ctrl-_` (31) -- as named `:special` events + (`:control-backslash`, `:control-right-bracket`, `:control-caret`, + `:control-underscore`) instead of falling through to an unprintable + `:character` event. `Ctrl-_` in particular is a common readline "undo" + binding +- input decoding: add a `:normalize-paste-line-endings` option to + `make-input-decoder`. When combined with `:collect-bracketed-paste`, a + collected `:paste` event's payload has CRLF and lone CR line endings + converted to LF, matching what a terminal that sends CR-terminated paste + lines needs to feed cleanly into an LF-delimited buffer. Off by default, so + existing callers see no behavior change +- **breaking (project infrastructure, not the public Lisp API):** move + `cl-prolog` off `:cl-tty-kit`'s `:depends-on` onto `:cl-tty-kit/test`'s. + `src/*.lisp` never referenced `cl-prolog` -- it is exercised only by + `t/sgr-prolog-oracle.lisp` and `t/prolog-*.lisp` as a differential-testing + oracle that cross-checks the hand-written SGR/CSI decoders against an + independent declarative specification, a pattern `docs/src/logic-engine.md` + already documented correctly even though the dependency itself, and + several other docs (the root README, `docs/src/installation.md`, + `docs/src/api-reference.md`, `docs/src/feature-audit.md`, + `docs/src/contrib.md`, `contrib/README.md`), described `cl-prolog` as a + core runtime dependency. `:cl-tty-kit` is now dependency-free except for + the conditional `#+sbcl sb-posix`; `flake.nix`'s `packages.cl-tty-kit` + build no longer needs `lispLibs` for this reason +- `examples/event-loop.lisp`: restructure the demo loop into explicit + continuation-passing style. `%event-loop-drive` takes a `chunk-source` + thunk plus `on-event`/`on-done` continuations and drives the decoder one + chunk at a time, instead of decoding every demo chunk into a list up front + and iterating it -- the shape a real event loop reading a live PTY or + socket must take, since there is no "rest of the input" to inspect until + the source thunk decides to produce it. `event-loop-example-events` and + `event-loop-example-render` now both drive through it; output is unchanged + (`t/input.lisp`'s documented event trace and `t/render-examples.lisp`'s + independently-computed frame sequence still match exactly) +- split `t/screen.lisp` (710 lines, the largest test file): the read-oriented + `SCREEN` API tests (fill, copy, row-string, scroll, blit, crop, ...) stay + there; the mutation/copy-on-write/error-path tests -- everything sharing + the "does this operation leave the right cell state, and does it copy a + caller-owned style list rather than alias it" theme -- move to the new + `t/screen-mutation.lisp`. src/'s largest/most-cited files (`color.lisp`, + `pty.lisp`, `text-layout.lisp`, `sixel.lisp`, `keys-decode-internals.lisp`, + all under 275 lines) were each read in full and found to already be one + cohesive concern with no natural seam, so none of them were split +- simplify `%decoder-decode-chunk-string` (`src/input-decode.lisp`): remove a + dead `when`-guarded buffer-size check that could never run, since + re-decoding an already-buffered incomplete UTF-8 tail against zero new + octets always yields an empty prefix by `%utf8-decode-prefix`'s own + contract (it always decodes everything decodable, leaving only the genuine + incomplete suffix behind). Closed with `paredit edit replace`; behavior is + unchanged, `src/input-decode.lisp` branch coverage moves from 87.5% to + 100% +- add regression coverage for two decoder edge cases that were previously + unexercised: feeding a string chunk to `decode-input-chunk` while UTF-8 + octets are still buffered from a prior octet chunk (both the normal and + the final-chunk/truncated-sequence-error cases), and `fd-write-octets`'s + internal EINTR retry (mocked via the existing `with-function-overrides` + test helper, since the real syscall essentially never returns EINTR in + CI) -- `src/pty-fd.lisp` branch coverage moves from 87.5% to 90.6% +- `t/properties.lisp`: add an allocation-budget regression guard for + `render-diff` on a worst-case 80x24 full repaint, using cl-weave's + `:to-allocate-under` matcher (a `describe`/`it` block, not one of the + existing `it-property` law checks) -- a first use of cl-weave's + performance-assertion matchers in this project, catching an accidental + O(n^2) blowup or a diff that stops discarding unchanged cells without the + flakiness a wall-clock `:to-run-under-ms` budget would have on shared CI + runners +- `t/keys.lisp`/`t/input.lisp`/`t/input-data.lisp`: replace 58 repetitions of + `(concatenate 'string (string #\Esc) "...")` with a shared `%esc` helper + (`(%esc "...")`), and rebuild the existing `%csi` helper on top of it. + Purely a boilerplate reduction; the generated test data is unchanged +- **breaking (project infrastructure, not the public Lisp API):** remove the + `vendor/cl-prolog` and `vendor/cl-weave` git submodules and `.gitmodules` + entirely. `nerima-lisp/cl-prolog` and `nerima-lisp/cl-weave` (upgraded to + v0.8.0 and v1.0.0 -- its first stable SemVer release -- respectively) are + now sourced exclusively through `flake.nix` inputs, which put both on + `CL_SOURCE_REGISTRY` for every app/check/devShell. [Nix](https://nixos.org) + is now the supported way to build, test, and develop `cl-tty-kit`; without + it, `cl-prolog`/`cl-weave` must be made discoverable to ASDF some other way + (for example, their own Quicklisp `local-projects` checkouts) since neither + ships with this repository anymore -- see the README and + `docs/src/installation.md` "Nix"/"Without Nix" sections +- add `flake.nix` inputs for `nerima-lisp/paredit-cli` alongside the two + above. `nix build` now produces a hermetic `cl-tty-kit` package (via + `sbcl.buildASDFSystem`) and a `coverage-report` package (a hermetic + `scripts/coverage.lisp`); `nix flake check` runs a hermetic test suite, a + `paredit-lint` structural-parse gate, and an `nixpkgs-fmt` formatting + check; `devShells.default` gains the `paredit-cli` binary and + `nixpkgs-fmt` +- rewrite `.github/workflows/ci.yml` around Nix: the `verify` job (matrix + `apt-get`/`brew`-installed SBCL, submodule checkout) is replaced by a `nix` + job (`x86_64-linux` / `aarch64-darwin` matrix) running `nix flake check`; + `coverage` now builds the `coverage-report` Nix package; `contrib` installs + Quicklisp and runs inside `nix develop` instead of a bare `apt-get`-provisioned + SBCL. All three jobs, plus `docs.yml`'s jobs, now carry `timeout-minutes` +- add `.github/actions/setup-nix`, a reusable composite action (Nix install + + optional Cachix) shared by `ci.yml`, mirroring `nerima-lisp/cl-prolog`'s own + ## 0.6.0 - 2026-07-25 - add an explicit timeout to `scripts/source-registry-smoke.lisp`, the one diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index f6e3a82..147c3bb 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -11,6 +11,11 @@ the core API focused, testable, and easy to embed in terminal applications. ## Verification +The scripts below assume `cl-prolog`/`cl-weave` are already on +`CL_SOURCE_REGISTRY`; run them inside `nix develop`, or use the equivalent +`nix run .#test` / `.#verify` / `.#coverage` shortcuts (see the root +`README.md` "Installation" section). + Run the repository-local test entrypoint from the project root: ```bash diff --git a/README.md b/README.md index ecd558a..999fca2 100644 --- a/README.md +++ b/README.md @@ -10,6 +10,7 @@ without turning the library into a UI framework or shell. ## Status +- **stable**: the public API is covered by the semantic-versioning guarantee below - full documentation site: - requires SBCL (see [Compatibility](#compatibility)) and intentionally small - test-backed public API @@ -18,6 +19,31 @@ without turning the library into a UI framework or shell. - maintainer-grade local quality gates are documented in `docs/QUALITY-GATES.md` - project governance docs are available in `CONTRIBUTING.md`, `CODE_OF_CONDUCT.md`, and `SECURITY.md` +### API stability + +From 1.0.0 onward `cl-tty-kit` follows [semantic versioning](https://semver.org). +The stable surface is precisely the set of symbols exported from the `cl-tty-kit` +package -- every one of them is enumerated in [API Overview](#api-overview) and +asserted against the live package by `t/package-introspection.lisp`, so this list +cannot silently drift from the code. + +Within the 1.x series: + +- exported symbols will not be removed or renamed, and existing arguments will + not change meaning; new functionality arrives as added symbols or added + `&key` arguments +- the shape of decoded input events (`key-event` type/code/modifiers) and the + condition hierarchy rooted at `tty-kit-error` are part of that contract +- rendered escape-sequence output may change only when it fixes an incorrect + sequence; `render-diff` remains free to choose any sequence of commands whose + visible result matches `render-screen`, which is what `t/properties.lisp` + asserts rather than a byte-for-byte transcript + +Explicitly *not* covered: anything named with a leading `%` (internal by +convention and unexported), `contrib/` (opt-in, isolated from the core build -- +see `contrib/README.md`), and the repository's own build/CI plumbing. Changes +requiring a 2.0 are described in `RELEASING.md`. + ## Compatibility `cl-tty-kit` currently **requires SBCL**. It relies on SBCL-only facilities: @@ -25,11 +51,13 @@ without turning the library into a UI framework or shell. classification, and `sb-ext` for UTF-8 transcoding and process/PTY handling. Loading the system on another Common Lisp implementation fails fast with a clear "requires SBCL" error rather than a confusing missing-dependency report. -Its other dependency, [`cl-prolog`](https://github.com/nerima-lisp/cl-prolog) -(the embedded logic engine; see "Design: relations and continuations" below), -is itself dependency-free and portable, and is vendored as a git submodule at -`vendor/cl-prolog` rather than distributed by Quicklisp -- `git submodule -update --init vendor/cl-prolog` once per checkout is all it needs. +The core system is otherwise dependency-free; its test system additionally +depends on [`cl-prolog`](https://github.com/nerima-lisp/cl-prolog) (the test +suite's embedded logic engine; see "Design: relations and continuations" +below) and `cl-weave` (the test framework), neither of which is distributed +by Quicklisp -- `nix develop`/`nix build`/`nix run` (see +[Installation](#installation)) put both on `CL_SOURCE_REGISTRY` via this +repository's `flake.nix`. Internally the code is still organized by portability of *concern*, which keeps the OS-facing surface small and isolated and makes the pure logic easy to test: @@ -461,23 +489,39 @@ and `close-pty` are available on every build that loads. ## Installation -Put the repository in a place ASDF can see, for example: +`cl-tty-kit.asd`'s test system, `:cl-tty-kit/test`, depends on +[`cl-prolog`](https://github.com/nerima-lisp/cl-prolog) and +[`cl-weave`](https://github.com/nerima-lisp/cl-weave) (the core `:cl-tty-kit` +system itself is dependency-free), neither of which is on Quicklisp -- +something has to put both on ASDF's `CL_SOURCE_REGISTRY`. [Nix](https://nixos.org) +is the supported way to do that, via `flake.nix`'s `cl-prolog`/`cl-weave` +inputs: + +```sh +nix develop # SBCL, Git, paredit-cli, nixpkgs-fmt on PATH; CL_SOURCE_REGISTRY pre-wired +nix run .#test # same scripts CI's `nix` job runs: test / verify / coverage +nix run .#verify +nix run .#coverage +nix build # hermetic `cl-tty-kit` package (sbcl.buildASDFSystem) +nix build .#docs # hermetic MkDocs (Material) site build, --strict +nix flake check # hermetic test suite + a paredit-lint structural-parse gate +``` + +Without Nix, put the repository somewhere ASDF can see it, for example: ```text ~/quicklisp/local-projects/cl-tty-kit/ ``` -Then load the repository-local bootstrap and core sources: +and make `cl-prolog` and `cl-weave` discoverable the same way (Quicklisp +`local-projects`, or your own `CL_SOURCE_REGISTRY` entry) before loading the +repository-local bootstrap and core sources: ```lisp (load "scripts/bootstrap.lisp") (cl-tty-kit/bootstrap:load-core-system) ``` -With [Nix](https://nixos.org) installed, `nix develop` drops into a shell -with SBCL and Git (for `git submodule update --init`) on `PATH`, and -`nix run .#test` / `.#verify` / `.#coverage` run the same scripts CI does. - ## Quick Start ```lisp @@ -601,6 +645,15 @@ transition as an incremental frame. ;; => (#S(KEY-EVENT :TYPE :PASTE :CODE "hello" :MODIFIERS NIL)) ``` +Some terminals send CR-terminated (or CRLF-terminated) lines inside a +bracketed paste rather than bare LF. Adding `:normalize-paste-line-endings t` +converts a collected `:paste` event's payload to LF-only before it is +emitted, so callers that insert paste text into an LF-delimited buffer do not +need to re-implement that scan. This has no effect unless +`:collect-bracketed-paste` is also true. See +[Input Decoding](https://nerima-lisp.github.io/cl-tty-kit/input-decoding/) +for the full option reference. + ### Character width A terminal cell is a column, not a character. `char-width` returns how many @@ -617,16 +670,19 @@ callers can align text that mixes ASCII, CJK, and emoji. ### Design: relations and continuations -The toolkit's embedded logic engine is +The test suite's embedded logic engine is [`nerima-lisp/cl-prolog`](https://github.com/nerima-lisp/cl-prolog) itself — -vendored as a git submodule at `vendor/cl-prolog` and depended on directly -(see "Compatibility" above), not reimplemented. It provides ISO-flavored -unification and proof search — ISO built-ins (cut, arithmetic, `findall/3`, -`assert`/`retract`, DCG grammars, and more), a continuation-passing resolver, -and an explicit, immutable-by-default rulebase. Rules are kept separate from -the plain data tables they reason about (width ranges, key decoding tables, -style codes), so the classification logic can be expressed as relations while -the data stays ordinary Lisp. +a `:cl-tty-kit/test` dependency via `flake.nix` (see "Compatibility" above), +not reimplemented, and not a runtime dependency of the core toolkit. It +provides ISO-flavored unification and proof search — ISO built-ins (cut, +arithmetic, `findall/3`, `assert`/`retract`, DCG grammars, and more), a +continuation-passing resolver, and an explicit, immutable-by-default +rulebase. The test suite states part of the toolkit's classification logic +(width ranges, key decoding tables, SGR codes) as relations over the same +plain Lisp data the hand-written imperative decoders classify, then +cross-checks the two as an independent specification -- see +[Logic Engine](https://nerima-lisp.github.io/cl-tty-kit/logic-engine/) for +the full oracle pattern. ```lisp (cl-prolog:define-rulebase *family* @@ -692,6 +748,11 @@ session with `with-raw-mode` using the provided `:fd`. ## Testing +The scripts below assume `cl-prolog`/`cl-weave` are already on +`CL_SOURCE_REGISTRY` (see [Installation](#installation)) — the simplest way +is running them inside `nix develop`, or via the equivalent `nix run .#test` +/ `.#verify` / `.#coverage` shortcuts. + Run the test suite from a fresh checkout with: ```bash diff --git a/RELEASING.md b/RELEASING.md index 83d8a2a..2b84e03 100644 --- a/RELEASING.md +++ b/RELEASING.md @@ -12,10 +12,31 @@ The project uses semantic versioning: - minor releases for additive API changes - major releases for breaking API, event-shape, or output changes -If a change improves the core design but changes rendered terminal output, input -decoding, or public symbol availability, treat it as a deliberate major-release -event and update the public contract aggressively instead of carrying a -compatibility layer. +### What the version guarantees + +From 1.0.0 onward, the *stable surface* is exactly the set of symbols exported +from the `cl-tty-kit` package. That set is enumerated in `README.md`'s "API +Overview" and asserted against the live package by +`t/package-introspection.lisp`, so the documented list and the code cannot +drift apart silently. Alongside the symbol names themselves, the contract +covers the shape of decoded input events (a `key-event`'s type, code, and +modifiers) and the condition hierarchy rooted at `tty-kit-error`. + +Outside the stable surface, and freely changeable in a minor or patch release: +`%`-prefixed internals, the opt-in integrations under `contrib/`, this +repository's build and CI plumbing (including `flake.nix`'s inputs and outputs), +and the exact byte sequence `render-diff` emits — that one is bounded only by +the property `t/properties.lisp` asserts, namely that its visible result matches +`render-screen` and it is never longer than a full repaint. + +### What requires a 2.0 + +Removing or renaming an exported symbol, changing what an existing argument +means, changing the shape of a decoded input event, or changing an escape +sequence in a way that alters correct rendered output. If a change improves the +core design but does any of these, treat it as a deliberate major-release event +and update the public contract aggressively instead of carrying a compatibility +layer — `docs/QUALITY-GATES.md` rejects compatibility shims by policy. ## Release checklist @@ -27,7 +48,7 @@ Before tagging a release: 2. Run the full verification script from the project root: ```bash - sbcl --script scripts/verify.lisp + nix run .#verify ``` This includes the repository-local tests, example smoke checks, and the @@ -45,8 +66,11 @@ Before tagging a release: 5. Bump `:version` in `cl-tty-kit.asd` to match the release being cut. 6. Confirm that `README.md` still matches the public API and current examples. 7. Smoke-test the examples on a clean SBCL environment if possible. -8. If contrib/vendor submodules changed, confirm they are pinned to the intended - upstream commits (`git submodule status`) before tagging. +8. If `flake.lock` moved (the `cl-prolog`/`cl-weave`/`paredit-cli`/`nixpkgs` + inputs), confirm `nix flake check --all-systems` still passes against the + new pins before tagging. `--all-systems` is not optional here: without it + Nix only evaluates outputs for the machine you are on, so a `nixpkgs` bump + that drops a platform `flake.nix` still advertises passes silently. ## Cutting the tag diff --git a/cl-tty-kit.asd b/cl-tty-kit.asd index 89c743f..2193063 100644 --- a/cl-tty-kit.asd +++ b/cl-tty-kit.asd @@ -1,10 +1,14 @@ -;; The embedded logic engine (see docs/src/logic-engine.md) is -;; nerima-lisp/cl-prolog itself, vendored as a git submodule at -;; vendor/cl-prolog rather than distributed by Quicklisp. ASDF -;; has no reason to know that path exists unless something tells it, so this -;; system registers its own directory tree before its :DEPENDS-ON is resolved, -;; the same way scripts/bootstrap.lisp does for every project script -- this -;; makes plain (asdf:load-system :cl-tty-kit) work standalone, independent of +;; nerima-lisp/cl-prolog and nerima-lisp/cl-weave (see docs/src/logic-engine.md +;; and t/sgr-prolog-oracle.lisp) are both used only by :CL-TTY-KIT/TEST below -- +;; cl-prolog as a differential-testing oracle cross-checking the hand-written +;; SGR/CSI decoders, cl-weave as the test framework -- never by :CL-TTY-KIT +;; itself, which stays dependency-free (see its :DEPENDS-ON). Neither is +;; distributed by Quicklisp; `nix develop`/`nix build`/`nix flake check` +;; resolve both from this project's flake inputs onto CL_SOURCE_REGISTRY (see +;; flake.nix), which :INHERIT-CONFIGURATION below picks up. This system +;; registers its own directory tree before its :DEPENDS-ON is resolved, the +;; same way scripts/bootstrap.lisp does for every project script -- this makes +;; plain (asdf:load-system :cl-tty-kit) work standalone, independent of ;; whichever script or REPL loads this file first. (eval-when (:compile-toplevel :load-toplevel :execute) (asdf:initialize-source-registry @@ -20,17 +24,15 @@ :homepage "https://github.com/nerima-lisp/cl-tty-kit" :bug-tracker "https://github.com/nerima-lisp/cl-tty-kit/issues" :source-control "git https://github.com/nerima-lisp/cl-tty-kit.git" - :version "0.6.0" + :version "1.0.0" ;; SB-POSIX is only used by the SBCL-specific raw-mode layer (which requires ;; it itself under #+sbcl). Gating the dependency on the feature keeps ASDF ;; from failing dependency resolution with a confusing "system sb-posix not ;; found" on non-SBCL hosts; instead src/package.lisp reports a clear - ;; SBCL-required error. See the README "Compatibility" section. CL-PROLOG - ;; (vendored at vendor/cl-prolog; see the source-registry note above) is - ;; itself dependency-free, so this remains the toolkit's complete dependency - ;; set. - :depends-on (#+sbcl #:sb-posix - #:cl-prolog) + ;; SBCL-required error. See the README "Compatibility" section. This is the + ;; toolkit's complete dependency set -- see the source-registry note above + ;; for why CL-PROLOG belongs to :CL-TTY-KIT/TEST instead. + :depends-on (#+sbcl #:sb-posix) :serial t :components ((:file "src/package") (:file "src/conditions") @@ -83,7 +85,7 @@ :author "nerima-lisp" :license "MIT" :serial t - :depends-on (#:cl-tty-kit #:cl-weave) + :depends-on (#:cl-tty-kit #:cl-prolog #:cl-weave) :components ((:file "t/package") (:file "t/package-data") (:file "t/suite") @@ -110,6 +112,7 @@ (:file "t/session") (:file "t/pty") (:file "t/screen") + (:file "t/screen-mutation") (:file "t/box") (:file "t/render-examples") (:file "t/render-core") diff --git a/contrib/README.md b/contrib/README.md index 815080d..dbdc5e0 100644 --- a/contrib/README.md +++ b/contrib/README.md @@ -1,26 +1,28 @@ # cl-tty-kit contrib Optional, opt-in integrations that layer external libraries on top of the core -toolkit. **Nothing here is part of the core `cl-tty-kit` build or CI** — the core -system's own dependencies are `sb-posix` and `cl-prolog` (see the root -README's "Compatibility" section). These modules pull additional libraries -from Quicklisp, or from the vendored git submodules under `vendor/`, and are -loaded explicitly. +toolkit. **Nothing here is part of the core `cl-tty-kit` build or CI** — +`:cl-tty-kit`'s own dependency is `sb-posix` (see the root README's +"Compatibility" section). These modules pull additional libraries from +Quicklisp, or from `nerima-lisp/cl-prolog`, `nerima-lisp/cl-weave`, and +`nerima-lisp/cl-parser-kit` via this repository's `flake.nix` (`nix develop` +puts all three on `CL_SOURCE_REGISTRY`, the same as `:cl-tty-kit/test`), and +are loaded explicitly. ## `cl-tty-kit-cl-prolog-csi-grammar` — DCG grammar via nerima-lisp/cl-prolog A declarative recognizer for the ECMA-48 CSI (Control Sequence Introducer) byte-class grammar, built on [`nerima-lisp/cl-prolog`](https://github.com/nerima-lisp/cl-prolog) -(vendored at `vendor/cl-prolog`, pinned to its latest upstream HEAD — it is -not distributed by Quicklisp). `src/input-decode.lisp` already decodes CSI -sequences imperatively on the render loop's hot path; this module instead -expresses that same sequence shape — zero or more parameter bytes, then zero -or more intermediate bytes, then exactly one final byte — as a `def-dcg-rule` +(pulled from this repository's `flake.nix` inputs — it is not distributed by +Quicklisp). `src/input-decode.lisp` already decodes CSI sequences +imperatively on the render loop's hot path; this module instead expresses +that same sequence shape — zero or more parameter bytes, then zero or more +intermediate bytes, then exactly one final byte — as a `def-dcg-rule` grammar run through `phrase`, demonstrating cl-prolog's DCG support independently of the hand-written decoder. ```lisp -(git submodule update --init vendor/cl-prolog) ; once, from the shell +;; nix develop -- puts cl-prolog on CL_SOURCE_REGISTRY, once per shell (asdf:load-system :cl-tty-kit-cl-prolog-csi-grammar) (tty-csi-grammar:csi-sequence-valid-p "1;1H") ; => T (cursor position) @@ -28,11 +30,31 @@ independently of the hand-written decoder. (tty-csi-grammar:csi-sequence-valid-p "1;1") ; => NIL (no final byte) ``` +## `cl-tty-kit-cl-parser-kit-csi-grammar` — combinator grammar via nerima-lisp/cl-parser-kit + +A second, independent declarative recognizer for the same ECMA-48 CSI grammar +as the DCG version above, built on +[`nerima-lisp/cl-parser-kit`](https://github.com/nerima-lisp/cl-parser-kit)'s +`seq`/`many`/`type-token` parser combinators instead of cl-prolog's DCG rules +(pulled from this repository's `flake.nix` inputs — it is not distributed by +Quicklisp). `contrib/verify-contrib.lisp` cross-checks the two grammars agree +on every case, the same differential-testing shape `t/sgr-prolog-oracle.lisp` +uses against the hand-written decoder. + +```lisp +;; nix develop -- puts cl-parser-kit on CL_SOURCE_REGISTRY, once per shell +(asdf:load-system :cl-tty-kit-cl-parser-kit-csi-grammar) + +(tty-csi-parser-kit-grammar:csi-sequence-valid-p "1;1H") ; => T (cursor position) +(tty-csi-parser-kit-grammar:csi-sequence-valid-p "38;5;196m") ; => T (SGR, 256-color fg) +(tty-csi-parser-kit-grammar:csi-sequence-valid-p "1;1") ; => NIL (no final byte) +``` + ## `cl-tty-kit-weave-tests` — property-based fuzz tests via nerima-lisp/cl-weave Property-based tests built on [`nerima-lisp/cl-weave`](https://github.com/nerima-lisp/cl-weave) -(vendored at `vendor/cl-weave`, pinned to its latest upstream HEAD — it is -not distributed by Quicklisp). `cl-weave`'s `it-property` generators +(pulled from this repository's `flake.nix` inputs — it is not distributed by +Quicklisp). `cl-weave`'s `it-property` generators (`gen-vector`, `gen-string`, `gen-character`, ...) fuzz `src/utf8.lisp`'s octet decoder and the public `cl-tty-kit:decode-input` entry point with thousands of arbitrary byte sequences, asserting the documented contract: @@ -42,7 +64,7 @@ that read attacker-controlled PTY bytes. It also regression-tests the DCG CSI grammar above. ```lisp -(git submodule update --init vendor/cl-weave) ; once, from the shell +;; nix develop -- puts cl-prolog and cl-weave on CL_SOURCE_REGISTRY, once per shell (asdf:load-system :cl-tty-kit-weave-tests) (cl-tty-kit/weave-property-tests:run-tests) ; => T on success @@ -66,10 +88,10 @@ loadable Lisp. ## Verifying the contrib `contrib/verify-contrib.lisp` exercises the Quicklisp-backed clweb tangle -integration, and additionally exercises the two vendored integrations above -when their submodules are checked out (skipped, not failed, otherwise): +integration, and additionally exercises the cl-prolog/cl-parser-kit/cl-weave +integrations above when ASDF can find the relevant system (skipped, not +failed, otherwise): ```bash -git submodule update --init vendor/cl-prolog vendor/cl-weave # optional -sbcl --script contrib/verify-contrib.lisp +nix develop --command sbcl --script contrib/verify-contrib.lisp ``` diff --git a/contrib/cl-parser-kit-csi-grammar.lisp b/contrib/cl-parser-kit-csi-grammar.lisp new file mode 100644 index 0000000..94d14b7 --- /dev/null +++ b/contrib/cl-parser-kit-csi-grammar.lisp @@ -0,0 +1,57 @@ +(defpackage #:cl-tty-kit/cl-parser-kit-csi-grammar + (:use #:cl) + (:import-from #:cl-parser-kit + #:make-token #:type-token #:many #:seq #:end-of-input + #:parse-tokens) + (:nicknames #:tty-csi-parser-kit-grammar) + (:documentation + "Advanced usage of nerima-lisp/cl-parser-kit: a parser-combinator +recognizer for the same ECMA-48 CSI (Control Sequence Introducer) byte-class +grammar contrib/cl-prolog-csi-grammar.lisp recognizes via cl-prolog's DCG +support. src/input-decode.lisp already decodes CSI sequences imperatively +for the render loop's hot path; this module is a second, independent +declarative specification of that same sequence shape -- zero or more +parameter bytes, then zero or more intermediate bytes, then exactly one +final byte -- built from cl-parser-kit's SEQ/MANY/TYPE-TOKEN combinators +instead of Prolog relations.") + (:export #:csi-sequence-valid-p)) + +(in-package #:cl-tty-kit/cl-parser-kit-csi-grammar) + +(defun %csi-byte-kind (char) + "Classify CHAR into an ECMA-48 CSI byte class, or NIL if it fits none." + (let ((code (char-code char))) + (cond ((<= #x30 code #x3F) :param) + ((<= #x20 code #x2F) :intermediate) + ((<= #x40 code #x7E) :final) + (t nil)))) + +(defun %tokenize-csi-body (string) + "Classify each character of STRING into a CL-PARSER-KIT token vector. +Returns (VALUES TOKENS VALID-P). VALID-P is false when STRING contains a +byte outside the three CSI byte ranges." + (let ((tokens '())) + (loop for char across string + for kind = (%csi-byte-kind char) + unless kind + do (return-from %tokenize-csi-body (values #() nil)) + do (push (make-token :type kind :text (string char) :value char) tokens)) + (values (coerce (nreverse tokens) 'vector) t))) + +(defparameter *csi-sequence-parser* + (seq (many (type-token :param)) + (many (type-token :intermediate)) + (type-token :final) + (end-of-input)) + "The ECMA-48 CSI-body grammar: PARAMETER-BYTES* INTERMEDIATE-BYTES* FINAL-BYTE. +The trailing END-OF-INPUT rejects a sequence with bytes past its final byte +-- e.g. \"1H2\" -- the way PHRASE's remainder check does for the DCG version.") + +(defun csi-sequence-valid-p (string) + "Return true when STRING is exactly one structurally valid ECMA-48 CSI +sequence body: zero or more parameter bytes, then zero or more intermediate +bytes, then exactly one final byte. STRING excludes the leading ESC [ that +introduces the sequence." + (multiple-value-bind (tokens valid-chars-p) (%tokenize-csi-body string) + (and valid-chars-p + (nth-value 0 (parse-tokens *csi-sequence-parser* tokens))))) diff --git a/contrib/cl-tty-kit-cl-parser-kit-csi-grammar.asd b/contrib/cl-tty-kit-cl-parser-kit-csi-grammar.asd new file mode 100644 index 0000000..2efb138 --- /dev/null +++ b/contrib/cl-tty-kit-cl-parser-kit-csi-grammar.asd @@ -0,0 +1,18 @@ +;;;; Optional contrib system. NOT part of the core cl-tty-kit build or CI. +;;;; +;;;; A parser-combinator recognizer for the ECMA-48 CSI byte-class grammar, +;;;; built on nerima-lisp/cl-parser-kit -- a second, independent declarative +;;;; specification of the same grammar cl-tty-kit-cl-prolog-csi-grammar +;;;; recognizes via cl-prolog's DCG support. Load it explicitly from inside +;;;; a Nix dev shell, which puts cl-parser-kit on CL_SOURCE_REGISTRY (see +;;;; flake.nix devShells.default.shellHook): +;;;; +;;;; nix develop +;;;; (asdf:load-system :cl-tty-kit-cl-parser-kit-csi-grammar) + +(asdf:defsystem #:cl-tty-kit-cl-parser-kit-csi-grammar + :description "Parser-combinator recognizer for the ECMA-48 CSI grammar, built on nerima-lisp/cl-parser-kit." + :author "nerima-lisp" + :license "MIT" + :depends-on (#:cl-parser-kit) + :components ((:file "cl-parser-kit-csi-grammar"))) diff --git a/contrib/cl-tty-kit-cl-prolog-csi-grammar.asd b/contrib/cl-tty-kit-cl-prolog-csi-grammar.asd index ae5bb29..855002b 100644 --- a/contrib/cl-tty-kit-cl-prolog-csi-grammar.asd +++ b/contrib/cl-tty-kit-cl-prolog-csi-grammar.asd @@ -1,10 +1,11 @@ ;;;; Optional contrib system. NOT part of the core cl-tty-kit build or CI. ;;;; ;;;; A DCG-based recognizer for the ECMA-48 CSI byte-class grammar, built on -;;;; the vendored nerima-lisp/cl-prolog (vendor/cl-prolog, latest HEAD). Load it -;;;; explicitly once the submodule is checked out: +;;;; nerima-lisp/cl-prolog. Load it explicitly from inside a Nix dev shell, +;;;; which puts cl-prolog on CL_SOURCE_REGISTRY (see flake.nix +;;;; devShells.default.shellHook): ;;;; -;;;; git submodule update --init vendor/cl-prolog +;;;; nix develop ;;;; (asdf:load-system :cl-tty-kit-cl-prolog-csi-grammar) (asdf:defsystem #:cl-tty-kit-cl-prolog-csi-grammar diff --git a/contrib/cl-tty-kit-weave-mutation-tests.asd b/contrib/cl-tty-kit-weave-mutation-tests.asd index 175c1ab..30ee719 100644 --- a/contrib/cl-tty-kit-weave-mutation-tests.asd +++ b/contrib/cl-tty-kit-weave-mutation-tests.asd @@ -1,14 +1,15 @@ ;;;; Optional contrib system. NOT part of the core cl-tty-kit build or CI. ;;;; -;;;; Mutation tests built on the vendored nerima-lisp/cl-weave -;;;; (vendor/cl-weave, latest HEAD): mutate a pure function's body (read live -;;;; from its SRC/ source file) and confirm the same case battery a unit test -;;;; would use kills every mutation. This measures whether the tests actually -;;;; notice a wrong implementation, which SB-COVER line/branch coverage alone -;;;; cannot show. Load and run it explicitly once the submodules are checked -;;;; out: +;;;; Mutation tests built on nerima-lisp/cl-weave: mutate a pure function's +;;;; body (read live from its SRC/ source file) and confirm the same case +;;;; battery a unit test would use kills every mutation. This measures +;;;; whether the tests actually notice a wrong implementation, which +;;;; SB-COVER line/branch coverage alone cannot show. Load and run it +;;;; explicitly from inside a Nix dev shell, which puts cl-prolog and +;;;; cl-weave on CL_SOURCE_REGISTRY (see flake.nix +;;;; devShells.default.shellHook): ;;;; -;;;; git submodule update --init vendor/cl-prolog vendor/cl-weave +;;;; nix develop ;;;; (asdf:load-system :cl-tty-kit-weave-mutation-tests) ;;;; (cl-tty-kit/weave-mutation-tests:run-tests) diff --git a/contrib/cl-tty-kit-weave-tests.asd b/contrib/cl-tty-kit-weave-tests.asd index 42b72c5..2bba87b 100644 --- a/contrib/cl-tty-kit-weave-tests.asd +++ b/contrib/cl-tty-kit-weave-tests.asd @@ -1,11 +1,12 @@ ;;;; Optional contrib system. NOT part of the core cl-tty-kit build or CI. ;;;; -;;;; Property-based fuzz tests built on the vendored nerima-lisp/cl-weave -;;;; (vendor/cl-weave, latest HEAD), exercising the UTF-8 and input decoders -;;;; against arbitrary octets plus the DCG-based CSI grammar. Load and run it -;;;; explicitly once the submodules are checked out: +;;;; Property-based fuzz tests built on nerima-lisp/cl-weave, exercising the +;;;; UTF-8 and input decoders against arbitrary octets plus the DCG-based CSI +;;;; grammar. Load and run it explicitly from inside a Nix dev shell, which +;;;; puts cl-prolog and cl-weave on CL_SOURCE_REGISTRY (see flake.nix +;;;; devShells.default.shellHook): ;;;; -;;;; git submodule update --init vendor/cl-prolog vendor/cl-weave +;;;; nix develop ;;;; (asdf:load-system :cl-tty-kit-weave-tests) ;;;; (cl-tty-kit/weave-property-tests:run-tests) diff --git a/contrib/verify-contrib.lisp b/contrib/verify-contrib.lisp index 5a19461..35a5e54 100644 --- a/contrib/verify-contrib.lisp +++ b/contrib/verify-contrib.lisp @@ -1,13 +1,16 @@ -;;;; Verify the optional contrib integrations. Run from the project root: +;;;; Verify the optional contrib integrations. Run from the project root +;;;; inside a Nix dev shell, which puts nerima-lisp/cl-prolog and +;;;; nerima-lisp/cl-weave on CL_SOURCE_REGISTRY (see flake.nix +;;;; devShells.default.shellHook): ;;;; -;;;; git submodule update --init vendor/cl-prolog vendor/cl-weave -;;;; sbcl --script contrib/verify-contrib.lisp +;;;; nix develop --command sbcl --script contrib/verify-contrib.lisp ;;;; ;;;; It exercises clweb (via tangling the literate module) from Quicklisp, -;;;; plus the vendored nerima-lisp/cl-prolog DCG grammar and nerima-lisp/cl-weave -;;;; property tests from vendor/ (both pinned at their latest upstream HEAD; -;;;; see .gitmodules). The vendored checks are skipped, not failed, when the -;;;; submodules have not been checked out. +;;;; plus the nerima-lisp/cl-prolog DCG grammar, the nerima-lisp/cl-parser-kit +;;;; combinator grammar, and nerima-lisp/cl-weave property tests. The +;;;; cl-prolog/cl-parser-kit/cl-weave checks are skipped, not failed, when +;;;; ASDF cannot find the relevant system (i.e. outside a Nix dev shell with +;;;; CL_SOURCE_REGISTRY pointed at none of them). (require :asdf) (load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname))) @@ -35,26 +38,48 @@ (equal '(:- (ancestor ?a ?b) (parent ?a ?b)) (funcall fn '((ancestor ?a ?b) (parent ?a ?b)))))))) -;;; --- vendored nerima-lisp/cl-prolog DCG grammar (vendor/, latest HEAD) ------- -(if (probe-file (merge-pathnames "vendor/cl-prolog/cl-prolog.asd" *root*)) +;;; --- nerima-lisp/cl-prolog DCG grammar -------------------------------------- +(if (asdf:find-system :cl-prolog nil) (progn (handler-bind ((warning #'muffle-warning)) (asdf:load-system :cl-tty-kit-cl-prolog-csi-grammar)) - (check "vendor/cl-prolog DCG grammar accepts a well-formed CSI body" + (check "cl-prolog DCG grammar accepts a well-formed CSI body" (funcall (read-from-string "tty-csi-grammar:csi-sequence-valid-p") "38;5;196m")) - (check "vendor/cl-prolog DCG grammar rejects an unterminated CSI body" + (check "cl-prolog DCG grammar rejects an unterminated CSI body" (not (funcall (read-from-string "tty-csi-grammar:csi-sequence-valid-p") "1;1")))) - (format t "~&[SKIP] vendor/cl-prolog not checked out (git submodule update --init)~%")) + (format t "~&[SKIP] cl-prolog not on CL_SOURCE_REGISTRY (run inside `nix develop`)~%")) -;;; --- vendored nerima-lisp/cl-weave property tests (vendor/, latest HEAD) ----- -(if (probe-file (merge-pathnames "vendor/cl-weave/cl-weave.asd" *root*)) +;;; --- nerima-lisp/cl-parser-kit combinator grammar --------------------------- +(if (asdf:find-system :cl-parser-kit nil) + (progn + (handler-bind ((warning #'muffle-warning)) + (asdf:load-system :cl-tty-kit-cl-parser-kit-csi-grammar)) + (check "cl-parser-kit combinator grammar accepts a well-formed CSI body" + (funcall (read-from-string "tty-csi-parser-kit-grammar:csi-sequence-valid-p") + "38;5;196m")) + (check "cl-parser-kit combinator grammar rejects an unterminated CSI body" + (not (funcall (read-from-string "tty-csi-parser-kit-grammar:csi-sequence-valid-p") + "1;1"))) + ;; The two independent grammars -- Prolog DCG and parser combinators -- + ;; must agree whenever both are loaded, the same differential-testing + ;; contract SGR-PROLOG-ORACLE holds against the hand-written decoder. + (when (asdf:find-system :cl-prolog nil) + (dolist (case '("1;1H" "38;5;196m" "?25h" "" "1;1" "1H2" "A" "9x;1" + ">0;276;0c" "1;1;104;200u")) + (check (format nil "grammars agree on ~S" case) + (eq (and (funcall (read-from-string "tty-csi-grammar:csi-sequence-valid-p") case) t) + (and (funcall (read-from-string "tty-csi-parser-kit-grammar:csi-sequence-valid-p") case) t)))))) + (format t "~&[SKIP] cl-parser-kit not on CL_SOURCE_REGISTRY (run inside `nix develop`)~%")) + +;;; --- nerima-lisp/cl-weave property tests ------------------------------------ +(if (asdf:find-system :cl-weave nil) (progn (handler-bind ((warning #'muffle-warning)) (asdf:load-system :cl-tty-kit-weave-tests)) - (check "vendor/cl-weave property-based decoder fuzz suite passes" + (check "cl-weave property-based decoder fuzz suite passes" (funcall (read-from-string "cl-tty-kit/weave-property-tests:run-tests")))) - (format t "~&[SKIP] vendor/cl-weave not checked out (git submodule update --init)~%")) + (format t "~&[SKIP] cl-weave not on CL_SOURCE_REGISTRY (run inside `nix develop`)~%")) (format t "~&==CONTRIB-OK==~%") diff --git a/docs/FEATURE-AUDIT.md b/docs/FEATURE-AUDIT.md index 7df0cfa..d18da72 100644 --- a/docs/FEATURE-AUDIT.md +++ b/docs/FEATURE-AUDIT.md @@ -160,7 +160,7 @@ against that boundary, not against full terminal emulation. | Capability | Status | Notes | |---|---|---| -| Unification + CPS resolution + clause DB | DONE | `nerima-lisp/cl-prolog`, depended on directly | +| Unification + CPS resolution + clause DB | DONE | `nerima-lisp/cl-prolog`, a test-suite dependency (differential-testing oracle) | --- diff --git a/docs/QUALITY-GATES.md b/docs/QUALITY-GATES.md index 987079a..577a68f 100644 --- a/docs/QUALITY-GATES.md +++ b/docs/QUALITY-GATES.md @@ -27,7 +27,9 @@ before it is treated as release-ready. ## Verification gate -Run these commands from the project root: +Run these commands from the project root, inside a Nix dev shell (`nix +develop`; see `docs/src/installation.md#nix`) so `cl-prolog`/`cl-weave` are on +`CL_SOURCE_REGISTRY`: ```bash sbcl --script scripts/test.lisp @@ -49,6 +51,26 @@ Expected outcomes: - coverage output is regenerated and inspected for meaningful gaps - the working tree contains no whitespace or merge-marker defects +### The local gate is weaker than CI on macOS + +Nix ships with `sandbox = false` on macOS (`nix config show sandbox`), so +`nix flake check` run locally on a Mac builds `checks.*.test` with the host +filesystem visible. CI's `x86_64-linux` runner sandboxes it, where the only +absolute paths that exist are `/bin/sh` and the Nix store. A test that reaches +for any other absolute path -- `/bin/sleep`, `/usr/bin/env`, a system config +file -- therefore passes locally on a Mac and fails only in CI. This is not +hypothetical: `t/pty.lisp`'s SIGTERM case spawned `/bin/sleep` and did exactly +that. + +Spawn external programs through `/bin/sh` and let `PATH` resolve the rest +(`:program "/bin/sh" :args '("-c" "exec sleep 5")`), and before trusting a +local green run on macOS for anything touching the filesystem or a +subprocess, reproduce CI's environment: + +```bash +nix build --option sandbox true .#checks.aarch64-darwin.test +``` + ## Coverage policy The target is meaningful coverage, not vanity percentages. @@ -59,6 +81,11 @@ The target is meaningful coverage, not vanity percentages. - files dominated by top-level definitions may under-report under `sb-cover`; treat those reports as instrumentation artifacts only after the exported contract is already exercised elsewhere +- the same artifact applies to `&key`/`&optional` default-value init-forms + inside ordinary `defun`s (verified: `src/cell.lisp`'s `make-cell` default + for `char` reports uncovered even though `%blank-cell` calls `(make-cell)` + on every blank screen cell) -- verify by testing the returned value when + the argument is omitted, not by chasing the source form to a covered state ## Macro usage policy diff --git a/docs/src/README.md b/docs/src/README.md index 98ca89e..4c24e3a 100644 --- a/docs/src/README.md +++ b/docs/src/README.md @@ -101,12 +101,30 @@ without turning into a UI framework or a shell. ## Status +- **stable**: the public API is covered by the semantic-versioning guarantee below - requires SBCL (see [Compatibility](compatibility.md)) and is intentionally small - test-backed public API, with runnable examples in `examples/` - PTY support is limited to SBCL - maintainer-grade local quality gates are documented in [Quality Gates](quality-gates.md) - project governance lives in [Contributing](contributing.md), `CODE_OF_CONDUCT.md`, and `SECURITY.md` +### API stability + +From 1.0.0 onward `cl-tty-kit` follows [semantic versioning](https://semver.org). +The stable surface is precisely the symbols exported from the `cl-tty-kit` +package — every one is listed in the [API Reference](api-reference.md) and +asserted against the live package by `t/package-introspection.lisp`, so that +list cannot silently drift from the code. + +Within the 1.x series exported symbols will not be removed or renamed and +existing arguments will not change meaning; new functionality arrives as added +symbols or added `&key` arguments. The shape of decoded input events and the +condition hierarchy rooted at `tty-kit-error` (see [Conditions](conditions.md)) +are part of that contract. Not covered: `%`-prefixed internals, the opt-in +integrations under [Contrib](contrib.md), and the repository's own build and CI +plumbing. See [Release Process](release-process.md) for what would require a +2.0. + ## Non-goals `cl-tty-kit` stops deliberately short of an application framework: diff --git a/docs/src/api-reference.md b/docs/src/api-reference.md index ddacfa3..e6e9c86 100644 --- a/docs/src/api-reference.md +++ b/docs/src/api-reference.md @@ -5,8 +5,8 @@ Every symbol below is exported from `src/package.lisp`. This page is for lookup and navigation; each group links to the guide page that carries the depth. !!! tip "Scope" - The core toolkit is a single package, `cl-tty-kit`. The embedded logic - engine is [`nerima-lisp/cl-prolog`](https://github.com/nerima-lisp/cl-prolog) + The core toolkit is a single package, `cl-tty-kit`. The test suite's + embedded logic engine is [`nerima-lisp/cl-prolog`](https://github.com/nerima-lisp/cl-prolog) itself, used directly under its own `cl-prolog` package — see [Logic Engine (Prolog)](logic-engine.md). diff --git a/docs/src/contrib.md b/docs/src/contrib.md index a0296c0..730f88a 100644 --- a/docs/src/contrib.md +++ b/docs/src/contrib.md @@ -2,34 +2,36 @@ `contrib/` holds optional, opt-in integrations that layer external libraries on top of the core toolkit. **Nothing here is part of the core `cl-tty-kit` -build or CI** — the core system's own dependencies are the conditional -`sb-posix` and `cl-prolog` (see [Compatibility](compatibility.md)). These -modules pull additional libraries from Quicklisp, or from vendored git -submodules under `vendor/`, and must be loaded explicitly. +build or CI** — `:cl-tty-kit`'s own dependency is the conditional `sb-posix` +(see [Compatibility](compatibility.md)). These modules pull additional +libraries from Quicklisp, or from `nerima-lisp/cl-prolog`, +`nerima-lisp/cl-weave`, and `nerima-lisp/cl-parser-kit` via this repository's +`flake.nix` (`nix develop` puts all three on `CL_SOURCE_REGISTRY`, the same +as `:cl-tty-kit/test`), and must be loaded explicitly. !!! note "Why isolate these from core CI" `.github/workflows/ci.yml` runs `contrib/verify-contrib.lisp` in its own - `contrib` job with `continue-on-error: true`. Submodule checkouts and - Quicklisp installs introduce network dependencies that a core language - toolkit's build should never require — a flaky network never blocks a - core merge, and a contrib regression never blocks a core release. + `contrib` job with `continue-on-error: true`. Quicklisp installs + introduce a network dependency that a core language toolkit's build + should never require — a flaky network never blocks a core merge, and a + contrib regression never blocks a core release. ## `cl-tty-kit-cl-prolog-csi-grammar` — DCG grammar via `nerima-lisp/cl-prolog` A declarative recognizer for the ECMA-48 CSI (Control Sequence Introducer) byte-class grammar, built on [`nerima-lisp/cl-prolog`](https://github.com/nerima-lisp/cl-prolog) -(vendored at `vendor/cl-prolog`, pinned to its latest upstream HEAD — it is -not distributed by Quicklisp). [Input Decoding](input-decoding.md) already -decodes CSI sequences imperatively on the render loop's hot path; this module -instead expresses that same sequence shape — zero or more parameter bytes, -then zero or more intermediate bytes, then exactly one final byte — as a -`def-dcg-rule` grammar run through `phrase`, demonstrating cl-prolog's DCG -support independently of the hand-written decoder. +(pulled from this repository's `flake.nix` inputs — it is not distributed by +Quicklisp). [Input Decoding](input-decoding.md) already decodes CSI sequences +imperatively on the render loop's hot path; this module instead expresses +that same sequence shape — zero or more parameter bytes, then zero or more +intermediate bytes, then exactly one final byte — as a `def-dcg-rule` +grammar run through `phrase`, demonstrating cl-prolog's DCG support +independently of the hand-written decoder. ```lisp -(git submodule update --init vendor/cl-prolog) ; once, from the shell +;; nix develop -- puts cl-prolog on CL_SOURCE_REGISTRY, once per shell (asdf:load-system :cl-tty-kit-cl-prolog-csi-grammar) (tty-csi-grammar:csi-sequence-valid-p "1;1H") ; => T (cursor position) @@ -37,12 +39,33 @@ support independently of the hand-written decoder. (tty-csi-grammar:csi-sequence-valid-p "1;1") ; => NIL (no final byte) ``` +## `cl-tty-kit-cl-parser-kit-csi-grammar` — combinator grammar via `nerima-lisp/cl-parser-kit` + +A second, independent declarative recognizer for the same ECMA-48 CSI grammar +as the DCG version above, built on +[`nerima-lisp/cl-parser-kit`](https://github.com/nerima-lisp/cl-parser-kit)'s +`seq`/`many`/`type-token` parser combinators instead of cl-prolog's DCG rules +(pulled from this repository's `flake.nix` inputs — it is not distributed by +Quicklisp). `contrib/verify-contrib.lisp` cross-checks the two grammars agree +on every case, the same differential-testing shape +[the SGR oracle](logic-engine.md#a-real-example-the-sgr-oracle) uses against +the hand-written decoder. + +```lisp +;; nix develop -- puts cl-parser-kit on CL_SOURCE_REGISTRY, once per shell +(asdf:load-system :cl-tty-kit-cl-parser-kit-csi-grammar) + +(tty-csi-parser-kit-grammar:csi-sequence-valid-p "1;1H") ; => T (cursor position) +(tty-csi-parser-kit-grammar:csi-sequence-valid-p "38;5;196m") ; => T (SGR, 256-color fg) +(tty-csi-parser-kit-grammar:csi-sequence-valid-p "1;1") ; => NIL (no final byte) +``` + ## `cl-tty-kit-weave-tests` — property-based fuzz tests via `nerima-lisp/cl-weave` Property-based tests built on -[`nerima-lisp/cl-weave`](https://github.com/nerima-lisp/cl-weave) (vendored -at `vendor/cl-weave`, pinned to its latest upstream HEAD — it is not -distributed by Quicklisp). `cl-weave`'s `it-property` generators +[`nerima-lisp/cl-weave`](https://github.com/nerima-lisp/cl-weave) (pulled +from this repository's `flake.nix` inputs — it is not distributed by +Quicklisp). `cl-weave`'s `it-property` generators (`gen-vector`, `gen-string`, `gen-character`, ...) fuzz the UTF-8 octet decoder and the public `cl-tty-kit:decode-input` entry point (see [Input Decoding](input-decoding.md)) with thousands of arbitrary byte @@ -53,7 +76,7 @@ that read attacker-controlled PTY bytes. It also regression-tests the DCG CSI grammar above. ```lisp -(git submodule update --init vendor/cl-weave) ; once, from the shell +;; nix develop -- puts cl-prolog and cl-weave on CL_SOURCE_REGISTRY, once per shell (asdf:load-system :cl-tty-kit-weave-tests) (cl-tty-kit/weave-property-tests:run-tests) ; => T on success @@ -80,10 +103,10 @@ full external ISO Prolog (swipl/gprolog/yap) — and tangles to loadable Lisp. ## Verifying the contrib `contrib/verify-contrib.lisp` exercises the Quicklisp-backed clweb tangle -integration, and additionally exercises the two vendored integrations above -when their submodules are checked out (skipped, not failed, otherwise): +integration, and additionally exercises the cl-prolog/cl-parser-kit/cl-weave +integrations above when ASDF can find the relevant system (skipped, not +failed, otherwise): ```bash -git submodule update --init vendor/cl-prolog vendor/cl-weave # optional -sbcl --script contrib/verify-contrib.lisp +nix develop --command sbcl --script contrib/verify-contrib.lisp ``` diff --git a/docs/src/contributing.md b/docs/src/contributing.md index d64c0a7..1c8cc15 100644 --- a/docs/src/contributing.md +++ b/docs/src/contributing.md @@ -13,6 +13,11 @@ see [Roadmap](roadmap.md) for what stays explicitly out of scope. ## Verification +The scripts below assume `cl-prolog`/`cl-weave` are already on +`CL_SOURCE_REGISTRY`; run them inside `nix develop`, or use the equivalent +`nix run .#test` / `.#verify` / `.#coverage` shortcuts (see +[Installation](installation.md#nix)). + Run the repository-local test entrypoint from the project root: ```bash @@ -77,14 +82,13 @@ When filing a bug, include: This site is built from `docs/src/*.md` with [MkDocs](https://www.mkdocs.org/) and the [Material](https://squidfunk.github.io/mkdocs-material/) theme. -Preview changes locally before opening a pull request: +`nix build .#docs` is what CI runs to publish to GitHub Pages (see +[Release Process](release-process.md)) — it builds fully offline in +`--strict` mode, so a broken internal link or an unlisted nav page fails the +build rather than publishing a silent gap. Build and review it locally +before opening a documentation pull request: ```bash -pip install mkdocs-material -mkdocs serve --config-file docs/mkdocs.yml +nix build .#docs +open result/index.html # or: xdg-open result/index.html on Linux ``` - -`mkdocs build --strict --config-file docs/mkdocs.yml` is what CI runs to -publish to GitHub Pages (see [Release Process](release-process.md)) — a -broken internal link or an unlisted page fails that build, so run it before -submitting a documentation patch. diff --git a/docs/src/feature-audit.md b/docs/src/feature-audit.md index 6cd34f7..1f4ce28 100644 --- a/docs/src/feature-audit.md +++ b/docs/src/feature-audit.md @@ -177,7 +177,7 @@ See [PTY](pty.md) for the full API. | Capability | Status | Notes | |---|---|---| -| Unification + CPS resolution + clause DB | DONE | `nerima-lisp/cl-prolog`, depended on directly | +| Unification + CPS resolution + clause DB | DONE | `nerima-lisp/cl-prolog`, a test-suite dependency (differential-testing oracle) | See [Logic Engine](logic-engine.md) for the full API. diff --git a/docs/src/input-decoding.md b/docs/src/input-decoding.md index b06b806..33d6ebd 100644 --- a/docs/src/input-decoding.md +++ b/docs/src/input-decoding.md @@ -99,6 +99,7 @@ named special keys or `:control-` events: | `Rubout` / `Backspace` (127 or 8) | `:special :backspace` | | `NUL` (0) | `:special :null` | | Ctrl-A .. Ctrl-Z | `:special :control-a` .. `:control-z` | +| Ctrl-\\, Ctrl-], Ctrl-^, Ctrl-_ | `:special :control-backslash`, `:control-right-bracket`, `:control-caret`, `:control-underscore` | ### UTF-8 @@ -277,6 +278,29 @@ to a single `:paste "hello"` event. If EOF arrives before the closing `ESC [ 201 ~`, flushing falls back to the raw marker-plus-characters stream, so no input is discarded or invented. +Some terminals send CR-terminated (or CRLF-terminated) lines inside a bracketed +paste rather than bare LF. Building the decoder with +`:normalize-paste-line-endings t` converts a collected `:paste` event's payload +to LF-only before it is emitted, so callers that insert paste text into an +LF-delimited buffer do not need to re-implement that scan: + +```lisp +(let ((decoder (cl-tty-kit:make-input-decoder :collect-bracketed-paste t + :normalize-paste-line-endings t))) + (cl-tty-kit:decode-input-chunk + decoder + (concatenate 'string + (string #\Esc) "[200~" + "one" (string #\Return) (string #\Newline) "two" + (string #\Esc) "[201~") + :eof t)) +;; => (#S(KEY-EVENT :TYPE :PASTE :CODE "one +;; two" :MODIFIERS NIL ...)) +``` + +This has no effect unless `:collect-bracketed-paste` is also true, since only +that mode produces a `:paste` event with an associated string to normalize. + ## A full event loop `examples/event-loop.lisp` composes the streaming decoder with the diff renderer diff --git a/docs/src/installation.md b/docs/src/installation.md index a22de48..01d7456 100644 --- a/docs/src/installation.md +++ b/docs/src/installation.md @@ -3,18 +3,46 @@ !!! info "Prerequisites" `cl-tty-kit` requires [SBCL](https://www.sbcl.org/) — see - [Compatibility](compatibility.md) for why. There is no Nix flake and no - packaged release artifact; the project is distributed as source, loaded - through [ASDF](https://asdf.common-lisp.dev/). + [Compatibility](compatibility.md) for why. The core system is otherwise + dependency-free; its test system, `:cl-tty-kit/test`, additionally + depends on [`cl-prolog`](https://github.com/nerima-lisp/cl-prolog) and + [`cl-weave`](https://github.com/nerima-lisp/cl-weave), neither of which + is on Quicklisp — [Nix](https://nixos.org) is the supported way to put + both on ASDF's `CL_SOURCE_REGISTRY`, via this repository's `flake.nix`. + There is no packaged release artifact for non-Nix installs; the project + is distributed as source, loaded through + [ASDF](https://asdf.common-lisp.dev/). + +## Nix -## Put the repository where ASDF can find it +```sh +nix develop # SBCL, Git, paredit-cli, nixpkgs-fmt on PATH; CL_SOURCE_REGISTRY pre-wired +nix run .#test # same scripts CI's `nix` job runs: test / verify / coverage +nix run .#verify +nix run .#coverage +nix build # hermetic `cl-tty-kit` package (sbcl.buildASDFSystem) +nix build .#docs # hermetic MkDocs (Material) site build, --strict +nix flake check # hermetic test suite + a paredit-lint structural-parse gate +``` + +`flake.nix` declares `nerima-lisp/cl-prolog`, `nerima-lisp/cl-weave`, and +`nerima-lisp/paredit-cli` as flake inputs — the same systems `cl-tty-kit.asd` +depends on — and every app, check, and `devShell` above puts them on +`CL_SOURCE_REGISTRY`. Continue with [Load it](#load-it) below once you're in +a Nix shell (or have `CL_SOURCE_REGISTRY` set some other way). -The simplest path is Quicklisp's `local-projects` directory: +## Without Nix + +Put the repository somewhere ASDF can see it, for example: ```text ~/quicklisp/local-projects/cl-tty-kit/ ``` +and make `cl-prolog` and `cl-weave` discoverable the same way — as their own +`local-projects` checkouts, or your own `CL_SOURCE_REGISTRY` entry — since +neither ships with `cl-tty-kit` or Quicklisp. + Any directory ASDF already searches works too — for example a path added to `asdf:*central-registry*` or `CL_SOURCE_REGISTRY`. @@ -27,9 +55,7 @@ Any directory ASDF already searches works too — for example a path added to === "git submodule" - If you are vendoring `cl-tty-kit` inside another project (the way - `cl-tty-kit` itself vendors optional integrations under `vendor/`, see - [Contrib](contrib.md)): + If you are vendoring `cl-tty-kit` inside another project: ```sh git submodule add https://github.com/nerima-lisp/cl-tty-kit.git \ @@ -42,7 +68,8 @@ Any directory ASDF already searches works too — for example a path added to `scripts/bootstrap.lisp`, that registers the project tree with ASDF's source registry and exposes helpers for loading the core system, the test system, and example files. This is the supported way to load the code — it works from -a plain checkout with no environment variables to export first: +a plain checkout with no environment variables to export first, as long as +`cl-prolog` is already on `CL_SOURCE_REGISTRY` (see above): ```lisp (load "scripts/bootstrap.lisp") @@ -64,7 +91,7 @@ once the project is on the source registry: ## Package and nicknames The core system exports its public API from the `cl-tty-kit` package. The -embedded logic engine is [`nerima-lisp/cl-prolog`](https://github.com/nerima-lisp/cl-prolog) +test suite's embedded logic engine is [`nerima-lisp/cl-prolog`](https://github.com/nerima-lisp/cl-prolog) itself, used directly under its own `cl-prolog` package — see [Logic Engine](logic-engine.md). @@ -74,24 +101,25 @@ itself, used directly under its own `cl-prolog` package — see ## Dependencies -The core system has two dependencies. `sb-posix` is conditional: used only by -the SBCL-specific raw-mode layer, gated behind `#+sbcl` so ASDF never fails -dependency resolution with a confusing "system not found" on a non-SBCL host. -On any other implementation, loading `cl-tty-kit` fails fast with a clear -"requires SBCL" error instead — see [Compatibility](compatibility.md). -`cl-prolog` (the embedded logic engine) is itself dependency-free and -portable; it is vendored as a git submodule at `vendor/cl-prolog` rather than -distributed by Quicklisp, and `cl-tty-kit.asd` registers that path -automatically, so `(asdf:load-system :cl-tty-kit)` resolves it without any -extra setup once the submodule is checked out (`git submodule update --init -vendor/cl-prolog`). - -Everything else — screen state, cursor state, rendering, UTF-8 handling, and -input decoding — is pure Common Lisp with no external dependencies. +The core `:cl-tty-kit` system has exactly one, conditional, dependency: +`sb-posix`, used only by the SBCL-specific raw-mode layer, gated behind +`#+sbcl` so ASDF never fails dependency resolution with a confusing "system +not found" on a non-SBCL host. On any other implementation, loading +`cl-tty-kit` fails fast with a clear "requires SBCL" error instead — see +[Compatibility](compatibility.md). Everything else — screen state, cursor +state, rendering, UTF-8 handling, and input decoding — is pure Common Lisp +with no external dependencies. + +`:cl-tty-kit/test` additionally depends on `cl-prolog` (the test suite's +differential-testing oracle; see [Logic Engine](logic-engine.md)) and +`cl-weave` (the test framework). Neither is distributed by Quicklisp; `nix +develop`/`nix build`/`nix run` (see [Nix](#nix) above) put both on +`CL_SOURCE_REGISTRY` via this repository's `flake.nix`, and +`cl-tty-kit.asd`'s `:depends-on` resolves them from there. ## Verifying the install -From a fresh checkout, the repository-local scripts double as an +From a Nix shell (`nix develop`), the repository-local scripts double as an installation smoke test: ```sh @@ -101,16 +129,17 @@ sbcl --script scripts/source-registry-smoke.lisp # fresh source-registry discov sbcl --script scripts/verify.lisp # all of the above in one pass ``` -`scripts/verify.lisp` is the same gate the CI matrix (Linux and macOS) runs -on every push — see [Quality Gates](quality-gates.md). +`scripts/verify.lisp` is what CI's `nix` job runs (via `nix flake check`) on +Linux and macOS on every push — see [Quality Gates](quality-gates.md). ## Optional integrations Optional, opt-in integrations that layer external libraries on top of the -core toolkit — a DCG grammar bridge, property-based fuzz tests via -`nerima-lisp/cl-weave`, an external ISO Prolog bridge, and a literate-program -source — live under `contrib/` and are never part of the core build or CI. -See [Contrib](contrib.md) for how to load them. +core toolkit — two independent CSI grammars (a `nerima-lisp/cl-prolog` DCG +and a `nerima-lisp/cl-parser-kit` combinator parser), property-based fuzz +tests via `nerima-lisp/cl-weave`, an external ISO Prolog bridge, and a +literate-program source — live under `contrib/` and are never part of the +core build or CI. See [Contrib](contrib.md) for how to load them. ## Next steps diff --git a/docs/src/logic-engine.md b/docs/src/logic-engine.md index 75f894d..4deb034 100644 --- a/docs/src/logic-engine.md +++ b/docs/src/logic-engine.md @@ -1,12 +1,13 @@ # Logic Engine (Prolog) `cl-tty-kit`'s embedded logic engine is -[`nerima-lisp/cl-prolog`](https://github.com/nerima-lisp/cl-prolog) itself — -vendored as a git submodule at `vendor/cl-prolog` and depended on directly by -the core system, not reimplemented. The toolkit uses it to express pure -decision logic as *relations* over ordinary Lisp data tables, keeping the data -(width ranges, key tables, SGR codes) apart from the classification logic that -reasons about it. +[`nerima-lisp/cl-prolog`](https://github.com/nerima-lisp/cl-prolog) itself, +not reimplemented. It is a `:cl-tty-kit/test` dependency, not a `:cl-tty-kit` +one (see [Installation](installation.md)): the core toolkit ships hand-written +imperative decoders on its hot paths, and the test suite states part of that +same classification logic as *relations* over ordinary Lisp data, using the +engine to cross-check the two independently rather than to decide anything at +runtime. !!! note "Why a logic engine in a terminal toolkit?" Terminal work is full of small classification problems — which SGR diff --git a/docs/src/quality-gates.md b/docs/src/quality-gates.md index e195112..d513859 100644 --- a/docs/src/quality-gates.md +++ b/docs/src/quality-gates.md @@ -29,7 +29,9 @@ repository, which remains the canonical copy checked by CI. ## Verification gate -Run these commands from the project root: +Run these commands from the project root, inside a Nix dev shell (`nix +develop`; see [Installation](installation.md#nix)) so `cl-prolog`/`cl-weave` +are on `CL_SOURCE_REGISTRY`: ```bash sbcl --script scripts/test.lisp @@ -51,6 +53,28 @@ Expected outcomes: - coverage output is regenerated and inspected for meaningful gaps - the working tree contains no whitespace or merge-marker defects +### The local gate is weaker than CI on macOS + +!!! warning "A green local run on a Mac is not a green CI run" + Nix ships with `sandbox = false` on macOS (`nix config show sandbox`), so + `nix flake check` run locally on a Mac builds `checks.*.test` with the + host filesystem visible. CI's `x86_64-linux` runner sandboxes it, where + the only absolute paths that exist are `/bin/sh` and the Nix store. + +A test that reaches for any other absolute path — `/bin/sleep`, +`/usr/bin/env`, a system config file — therefore passes locally on a Mac and +fails only in CI. This is not hypothetical: `t/pty.lisp`'s SIGTERM case +spawned `/bin/sleep` and did exactly that. + +Spawn external programs through `/bin/sh` and let `PATH` resolve the rest +(`:program "/bin/sh" :args '("-c" "exec sleep 5")`), and before trusting a +local green run on macOS for anything touching the filesystem or a +subprocess, reproduce CI's environment: + +```bash +nix build --option sandbox true .#checks.aarch64-darwin.test +``` + ## Macro usage and file organization `defmacro` is for genuine compile-time shape: a family of near-identical @@ -78,14 +102,29 @@ instrumentation does not mark that as "entered" the way an `if`/`when` branch is marked — treat such a report as a tooling artifact, not a gap, once the exported contract is verified elsewhere. +The same artifact shows up one level down, inside ordinary `defun`s: an +`&key`/`&optional` default-value init-form (`(defun make-cell (&key (char +#\Space) style)) ...)`) is compiled as part of the lambda-list-parsing +prologue rather than the instrumented function body, so `sb-cover` marks it +"not executed" even when the function is called without that argument -- +`%blank-cell` calls `(make-cell)` on every blank screen cell in this +codebase, and `char`'s `#\Space` default in `src/cell.lisp` still reports as +uncovered. Verify by testing what the function *returns* when the argument +is omitted (already true for `make-cell`'s default, per the test above), +not by chasing the source form itself to a covered state -- it cannot +reach one. + ## What CI actually runs The gate above is what `.github/workflows/ci.yml` enforces on every push and -pull request, across an `ubuntu-latest` / `macos-latest` matrix for the -`verify` job, plus a separate `coverage` job. A third `contrib` job exercises -the opt-in integrations under `contrib/` (see [Contrib](contrib.md)) on a -best-effort, `continue-on-error` basis — submodule or Quicklisp network -flakiness there never blocks a core merge. +pull request, across an `x86_64-linux` / `aarch64-darwin` matrix for the +`nix` job (`nix flake check --all-systems`: the hermetic test suite, +`paredit-lint`, and `nixpkgs-fmt` formatting, evaluated for every platform in +`flake.nix`'s `systems` list rather than only the runner's own), plus a +separate `coverage` job. A third `contrib` +job exercises the opt-in integrations under `contrib/` (see +[Contrib](contrib.md)) on a best-effort, `continue-on-error` basis — +Quicklisp network flakiness there never blocks a core merge. See [Release Process](release-process.md) for how this gate fits into cutting a tagged release. diff --git a/docs/src/release-process.md b/docs/src/release-process.md index 99c0cb2..7065cb9 100644 --- a/docs/src/release-process.md +++ b/docs/src/release-process.md @@ -12,10 +12,33 @@ The project uses semantic versioning: - minor releases for additive API changes - major releases for breaking API, event-shape, or output changes -If a change improves the core design but changes rendered terminal output, -input decoding, or public symbol availability, treat it as a deliberate -major-release event and update the public contract aggressively instead of -carrying a compatibility layer. +### What the version guarantees + +From 1.0.0 onward, the *stable surface* is exactly the set of symbols exported +from the `cl-tty-kit` package. That set is listed in the +[API Reference](api-reference.md) and asserted against the live package by +`t/package-introspection.lisp`, so the documented list and the code cannot +drift apart silently. Alongside the symbol names themselves, the contract +covers the shape of decoded input events (a `key-event`'s type, code, and +modifiers — see [Input Decoding](input-decoding.md)) and the condition +hierarchy rooted at `tty-kit-error` (see [Conditions](conditions.md)). + +Outside the stable surface, and freely changeable in a minor or patch release: +`%`-prefixed internals, the opt-in integrations under [Contrib](contrib.md), +this repository's build and CI plumbing (including `flake.nix`'s inputs and +outputs), and the exact byte sequence `render-diff` emits — that one is bounded +only by the property `t/properties.lisp` asserts, namely that its visible +result matches `render-screen` and it is never longer than a full repaint. + +### What requires a 2.0 + +Removing or renaming an exported symbol, changing what an existing argument +means, changing the shape of a decoded input event, or changing an escape +sequence in a way that alters correct rendered output. If a change improves the +core design but does any of these, treat it as a deliberate major-release event +and update the public contract aggressively instead of carrying a compatibility +layer — [Quality Gates](quality-gates.md) rejects compatibility shims by +policy. ## Release checklist @@ -27,7 +50,7 @@ Before tagging a release: 2. Run the full verification script from the project root: ```bash - sbcl --script scripts/verify.lisp + nix run .#verify ``` This includes the repository-local tests, example smoke checks, and the @@ -47,9 +70,12 @@ Before tagging a release: examples — `t/package-readme.lisp` checks this mechanically, but review it by hand too. 7. Smoke-test the examples on a clean SBCL environment if possible. -8. If `contrib/`/`vendor/` submodules changed, confirm they are pinned to the - intended upstream commits (`git submodule status`) before tagging — see - [Contrib](contrib.md). +8. If `flake.lock` moved (the `cl-prolog`/`cl-weave`/`paredit-cli`/`nixpkgs` + inputs), confirm `nix flake check --all-systems` still passes against the + new pins before tagging — see [Contrib](contrib.md). `--all-systems` is not + optional here: without it Nix only evaluates outputs for the machine you are + on, so a `nixpkgs` bump that drops a platform `flake.nix` still advertises + passes silently. ## Cutting the tag @@ -80,9 +106,10 @@ test suite in the same patch so the new surface is explicit and executable. ## Publishing documentation This documentation site is rebuilt and deployed to GitHub Pages by -`.github/workflows/docs.yml` whenever `docs/**` changes on `main` (or on -manual dispatch). The workflow installs `mkdocs-material` with `pip`, runs -`mkdocs build --strict --config-file docs/mkdocs.yml`, and publishes the -result through `actions/deploy-pages`. A documentation change does not -require a version bump or a tag — it publishes independently of the release -checklist above. +`.github/workflows/docs.yml` whenever `docs/**`, `flake.nix`, or `flake.lock` +changes on `main` (or on manual dispatch). The workflow builds the hermetic +`nix build .#docs` package (`--strict`, so a broken internal link or an +unlisted nav page fails the build instead of publishing a silent gap) and +publishes the result through `actions/deploy-pages`. A documentation change +does not require a version bump or a tag — it publishes independently of the +release checklist above. diff --git a/examples/bootstrap.lisp b/examples/bootstrap.lisp index be659c1..7ced48a 100644 --- a/examples/bootstrap.lisp +++ b/examples/bootstrap.lisp @@ -3,3 +3,36 @@ (unless (find-package :cl-tty-kit) (cl-tty-kit/bootstrap:load-core-system)) + +(defun %chunk-source (chunks) + "Return a thunk producing each of CHUNKS in turn, then NIL. +Shared by the examples that decode a fixed list of chunks incrementally +(event-loop.lisp, streaming-paste.lisp): stands in for a live read from a +PTY or stdin, so %DECODE-CHUNKS-CPS below can only ever ask for the next +chunk, never inspect \"the rest of the input\", because in a real event loop +there is no such thing until this thunk decides to produce it." + (lambda () + (when chunks + (pop chunks)))) + +(defun %decode-chunks-cps (chunk-source on-event on-done) + "Feed CHUNK-SOURCE's output through an incremental CL-TTY-KIT input +decoder, in continuation-passing style: ON-EVENT is called with each decoded +KEY-EVENT as soon as it is available, and ON-DONE once with no arguments +after the final chunk is flushed. This is the shape a real event loop over a +live PTY or socket must take -- it drives itself forward chunk by chunk +rather than decoding a whole batch up front -- so these examples take it +too, even though their CHUNK-SOURCE happens to be backed by a fixed list." + (let ((decoder (cl-tty-kit:make-input-decoder :collect-bracketed-paste t))) + (labels ((step-loop () + (let ((chunk (funcall chunk-source))) + (if chunk + (progn + (dolist (event (cl-tty-kit:decode-input-chunk decoder chunk)) + (funcall on-event event)) + (step-loop)) + (progn + (dolist (event (cl-tty-kit:flush-input-decoder decoder)) + (funcall on-event event)) + (funcall on-done)))))) + (step-loop)))) diff --git a/examples/event-loop.lisp b/examples/event-loop.lisp index f17106d..e2546d3 100644 --- a/examples/event-loop.lisp +++ b/examples/event-loop.lisp @@ -23,14 +23,11 @@ previous-cursor) (defun event-loop-example-events () - (let ((decoder (cl-tty-kit:make-input-decoder :collect-bracketed-paste t)) - (events '())) - (dolist (chunk +event-loop-demo-chunks+) - (setf events - (nconc events - (copy-list (cl-tty-kit:decode-input-chunk decoder chunk))))) - (nconc events - (copy-list (cl-tty-kit:flush-input-decoder decoder))))) + (let ((events '())) + (%decode-chunks-cps (%chunk-source +event-loop-demo-chunks+) + (lambda (event) (push event events)) + (lambda ())) + (nreverse events))) (defun %event-loop-event-label (event) (case (cl-tty-kit:key-event-type event) @@ -112,9 +109,11 @@ :bracketed-paste t :keyboard-enhancements 1) (%event-loop-render-frame state stream) - (dolist (event (event-loop-example-events)) - (%event-loop-advance state event) - (%event-loop-render-frame state stream))))) + (%decode-chunks-cps (%chunk-source +event-loop-demo-chunks+) + (lambda (event) + (%event-loop-advance state event) + (%event-loop-render-frame state stream)) + (lambda ()))))) (defun run-event-loop-example () (format t "~A~%" (event-loop-example-render))) diff --git a/examples/streaming-paste.lisp b/examples/streaming-paste.lisp index 396a2a4..3cae27c 100644 --- a/examples/streaming-paste.lisp +++ b/examples/streaming-paste.lisp @@ -8,16 +8,18 @@ (defvar *cl-tty-kit-run-example-on-load* t) (defun streaming-paste-example () - (let ((decoder (cl-tty-kit:make-input-decoder :collect-bracketed-paste t)) - (events '())) - (dolist (chunk (list (concatenate 'string (string #\Esc) "[200~he") - "llo" - (concatenate 'string (string #\Esc) "[201~"))) - (setf events - (nconc events - (copy-list (cl-tty-kit:decode-input-chunk decoder chunk))))) - (nconc events - (copy-list (cl-tty-kit:flush-input-decoder decoder))))) + "Decode a bracketed paste split across chunks, in continuation-passing +style via %DECODE-CHUNKS-CPS (bootstrap.lisp): each chunk is fed to the +decoder as if it just arrived from a live PTY or socket read, rather than +concatenated and decoded as one batch up front." + (let ((events '())) + (%decode-chunks-cps + (%chunk-source (list (concatenate 'string (string #\Esc) "[200~he") + "llo" + (concatenate 'string (string #\Esc) "[201~"))) + (lambda (event) (push event events)) + (lambda ())) + (nreverse events))) (defun run-streaming-paste-example () (dolist (event (streaming-paste-example)) diff --git a/flake.lock b/flake.lock index 0b9301e..4f2c249 100644 --- a/flake.lock +++ b/flake.lock @@ -1,5 +1,83 @@ { "nodes": { + "cl-parser-kit": { + "inputs": { + "cl-prolog": [ + "cl-prolog" + ], + "cl-weave": [ + "cl-weave" + ], + "nixpkgs": [ + "nixpkgs" + ], + "paredit-cli": [ + "paredit-cli" + ] + }, + "locked": { + "lastModified": 1784994153, + "narHash": "sha256-gzJRhx4gjAoQYjkq6F9jw1S5hCvf3irIphZik2R9OmQ=", + "owner": "nerima-lisp", + "repo": "cl-parser-kit", + "rev": "fd502b1a558af5a2e929cbc91e9c6be111e54398", + "type": "github" + }, + "original": { + "owner": "nerima-lisp", + "repo": "cl-parser-kit", + "type": "github" + } + }, + "cl-prolog": { + "inputs": { + "cl-weave": [ + "cl-weave" + ], + "nixpkgs": [ + "nixpkgs" + ], + "paredit-cli": [ + "paredit-cli" + ] + }, + "locked": { + "lastModified": 1784953575, + "narHash": "sha256-S7SPfYAtSZpAf2vCbEH7GcatfxT7DZV/aSn2OXFVF3Y=", + "owner": "nerima-lisp", + "repo": "cl-prolog", + "rev": "b3275ad2697ebcdcd97f1f9f586426d750d3ddb7", + "type": "github" + }, + "original": { + "owner": "nerima-lisp", + "repo": "cl-prolog", + "type": "github" + } + }, + "cl-weave": { + "inputs": { + "nixpkgs": [ + "nixpkgs" + ], + "paredit-cli": [ + "paredit-cli" + ] + }, + "locked": { + "lastModified": 1784975971, + "narHash": "sha256-sKdp3H7SI8DaeqTChDX8IE9Fr7YU5Y8FHbclJGFtBMs=", + "owner": "nerima-lisp", + "repo": "cl-weave", + "rev": "81e27d367c0b5d295261d9eb7d9dbca4b7c8ea56", + "type": "github" + }, + "original": { + "owner": "nerima-lisp", + "repo": "cl-weave", + "type": "github" + } + }, "nixpkgs": { "locked": { "lastModified": 1784796856, @@ -16,9 +94,77 @@ "type": "github" } }, + "paredit-cli": { + "inputs": { + "nixpkgs": [ + "nixpkgs" + ], + "rust-overlay": "rust-overlay", + "treefmt-nix": "treefmt-nix" + }, + "locked": { + "lastModified": 1784977300, + "narHash": "sha256-edlX2EkanXV4tOS0Ncww/mzlJF2MBtBiXOk6ThzOiHg=", + "owner": "nerima-lisp", + "repo": "paredit-cli", + "rev": "c3a9079c79a1679c76335f3b00ea91881d30b10b", + "type": "github" + }, + "original": { + "owner": "nerima-lisp", + "repo": "paredit-cli", + "type": "github" + } + }, "root": { "inputs": { - "nixpkgs": "nixpkgs" + "cl-parser-kit": "cl-parser-kit", + "cl-prolog": "cl-prolog", + "cl-weave": "cl-weave", + "nixpkgs": "nixpkgs", + "paredit-cli": "paredit-cli" + } + }, + "rust-overlay": { + "inputs": { + "nixpkgs": [ + "paredit-cli", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1783663825, + "narHash": "sha256-TTrNVoFdEw8j0Hn+shP1KAsimTmszTWBIIUliTaAuY0=", + "owner": "oxalica", + "repo": "rust-overlay", + "rev": "072adf9b18936c1062c48123a9b77891d5968f2c", + "type": "github" + }, + "original": { + "owner": "oxalica", + "repo": "rust-overlay", + "type": "github" + } + }, + "treefmt-nix": { + "inputs": { + "nixpkgs": [ + "paredit-cli", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1780220602, + "narHash": "sha256-eynAfOmbmxJnkp7YewvCEbShNnnYJ9gLLqkzsYtBPeM=", + "owner": "numtide", + "repo": "treefmt-nix", + "rev": "db947814a175b7ca6ded66e21383d938df01c227", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "treefmt-nix", + "type": "github" } } }, diff --git a/flake.nix b/flake.nix index 8b470b7..49d7e94 100644 --- a/flake.nix +++ b/flake.nix @@ -3,37 +3,214 @@ inputs.nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable"; + # cl-tty-kit itself is dependency-free; cl-prolog and cl-weave are both + # :cl-tty-kit/test-only dependencies (see cl-tty-kit.asd :depends-on and + # cl-tty-kit/test :depends-on). Neither is distributed by Quicklisp, and + # this project keeps no vendored copy of either: these two flake inputs + # are the only source of both, put on CL_SOURCE_REGISTRY by every + # app/check/devShell below. + inputs.cl-prolog.url = "github:nerima-lisp/cl-prolog"; + inputs.cl-prolog.inputs.nixpkgs.follows = "nixpkgs"; + inputs.cl-prolog.inputs.cl-weave.follows = "cl-weave"; + inputs.cl-prolog.inputs.paredit-cli.follows = "paredit-cli"; + + inputs.cl-weave.url = "github:nerima-lisp/cl-weave"; + inputs.cl-weave.inputs.nixpkgs.follows = "nixpkgs"; + inputs.cl-weave.inputs.paredit-cli.follows = "paredit-cli"; + + # paredit-cli provides structural S-expression tooling for this repo's + # Lisp sources: a dev-shell binary for agent-driven refactors and a + # structural-parse lint gate reused in `checks`. + inputs.paredit-cli.url = "github:nerima-lisp/paredit-cli"; + inputs.paredit-cli.inputs.nixpkgs.follows = "nixpkgs"; + + # contrib/cl-parser-kit-csi-grammar.lisp's dependency: an opt-in second, + # independent declarative specification of the ECMA-48 CSI byte-class + # grammar (see contrib/cl-prolog-csi-grammar.lisp for the first, built on + # cl-prolog's DCG support instead). Never part of the core build/CI. + inputs.cl-parser-kit.url = "github:nerima-lisp/cl-parser-kit"; + inputs.cl-parser-kit.inputs.nixpkgs.follows = "nixpkgs"; + inputs.cl-parser-kit.inputs.cl-prolog.follows = "cl-prolog"; + inputs.cl-parser-kit.inputs.cl-weave.follows = "cl-weave"; + inputs.cl-parser-kit.inputs.paredit-cli.follows = "paredit-cli"; + outputs = - { nixpkgs, ... }: + { self, nixpkgs, cl-prolog, cl-weave, paredit-cli, cl-parser-kit }: let + # x86_64-darwin is deliberately absent: nixpkgs 26.11 (which + # nixos-unstable now tracks) dropped support for it outright, so every + # output for that platform fails to evaluate, not merely to build. + # Listing it would make `nix flake check --all-systems` a guaranteed + # error and advertise a platform this flake cannot serve. systems = [ "x86_64-linux" "aarch64-linux" - "x86_64-darwin" "aarch64-darwin" ]; forEachSystem = nixpkgs.lib.genAttrs systems; pkgsFor = system: nixpkgs.legacyPackages.${system}; - # Runs a repository script from the current working directory rather - # than from the flake's own (submodule-free) source copy: ASDF loading - # this system needs vendor/cl-prolog and vendor/cl-weave, which are git - # submodules `git submodule update --init` populates locally but that - # Nix's git-tracked-files filtering of `self` never includes. Running - # against the working directory is exactly what the README and CI - # already do (`sbcl --script scripts/.lisp` from a checkout with - # submodules initialized), so this stays consistent with them instead - # of re-deriving a hermetic build that this project's architecture - # doesn't support. + + # Single source of truth for the project version: parse `:version` + # straight out of cl-tty-kit.asd so the flake can never drift from the + # ASDF system definition. + projectVersion = + let + asd = builtins.readFile ./cl-tty-kit.asd; + # Match only lines that are literally `:version "X"`, so a comment + # or docstring merely mentioning :version can never shadow the + # real definition. + matches = builtins.filter (m: m != null) ( + map (builtins.match ''[[:space:]]*:version[[:space:]]+"([^"]+)".*'') ( + nixpkgs.lib.splitString "\n" asd + ) + ); + in + assert matches != [ ]; + builtins.head (builtins.head matches); + + sourceFor = pkgs: pkgs.lib.cleanSource ./.; + + # cl-prolog, cl-weave, and cl-parser-kit as raw ASDF-loadable source + # trees (not the `packages` outputs above, which are shaped for + # `lispLibs` composition rather than for CL_SOURCE_REGISTRY directly). + # This -- not any vendored copy -- is the only place any + # app/check/devShell below gets any of the three from. cl-parser-kit + # is only a contrib/ dependency, but sharing one registry string with + # cl-prolog/cl-weave keeps every entry point able to load contrib/ + # interactively without a separate CL_SOURCE_REGISTRY variant to track. + clSourceRegistryFor = "${cl-prolog}//:${cl-weave}//:${cl-parser-kit}//:"; + + # Runs a repository script against the current working directory (so + # local edits are picked up without rebuilding a Nix package), with + # CL_SOURCE_REGISTRY pointed at this flake's own cl-prolog/cl-weave + # inputs so cl-tty-kit.asd's :depends-on resolves without any vendored + # copy on disk. + # `meta.description` is what `nix flake show` renders and what + # `nix flake check` warns about when absent; these four apps are this + # project's documented entry points (README, docs/src/installation.md, + # RELEASING.md), so they carry one. scriptApp = - pkgs: name: script: + pkgs: name: script: description: { type = "app"; program = "${pkgs.writeShellScript name '' + export CL_SOURCE_REGISTRY="${clSourceRegistryFor}''${CL_SOURCE_REGISTRY:-}" exec ${pkgs.sbcl}/bin/sbcl --script scripts/${script} "$@" ''}"; + meta = { inherit description; }; + }; + + # `nix build .#docs` -- a hermetic, offline MkDocs (Material) build so + # publishing to GitHub Pages never depends on a bare `pip install` + # inside CI. Material for MkDocs bundles all of its own assets, so no + # network access is required inside the Nix sandbox. Restricting `src` + # to just mkdocs.yml and docs/src keeps this derivation's cache key + # from changing on unrelated source/test edits, and `--strict` promotes + # a broken internal link or an unlisted nav page to a build failure + # instead of a silent gap once this is live. + mkDocs = + pkgs: + pkgs.stdenvNoCC.mkDerivation { + pname = "cl-tty-kit-docs"; + version = projectVersion; + src = pkgs.lib.fileset.toSource { + root = ./docs; + fileset = pkgs.lib.fileset.unions [ + ./docs/mkdocs.yml + ./docs/src + ]; + }; + nativeBuildInputs = [ pkgs.python3Packages.mkdocs-material ]; + buildPhase = '' + runHook preBuild + mkdocs build --strict --config-file mkdocs.yml --site-dir "$out" + runHook postBuild + ''; + dontInstall = true; + meta = { + description = "Rendered MkDocs (Material) documentation for cl-tty-kit"; + homepage = "https://github.com/nerima-lisp/cl-tty-kit"; + license = pkgs.lib.licenses.mit; + }; }; in { + formatter = forEachSystem (system: (pkgsFor system).nixpkgs-fmt); + + packages = forEachSystem ( + system: + let + pkgs = pkgsFor system; + src = sourceFor pkgs; + in + { + # No lispLibs: :cl-tty-kit itself is dependency-free (see + # cl-tty-kit.asd) -- cl-prolog is only a :cl-tty-kit/test dependency. + cl-tty-kit = pkgs.sbcl.buildASDFSystem { + pname = "cl-tty-kit"; + version = projectVersion; + inherit src; + systems = [ "cl-tty-kit" ]; + }; + default = self.packages.${system}.cl-tty-kit; + + # `nix build .#coverage-report` -- a hermetic equivalent of + # `sbcl --script scripts/coverage.lisp`, for CI to upload as an + # artifact without a local SBCL/submodule checkout. + coverage-report = pkgs.runCommand "cl-tty-kit-coverage-report" { nativeBuildInputs = [ pkgs.sbcl ]; } '' + cp -R ${src} source + chmod -R u+w source + cd source + export HOME="$TMPDIR/home" + export XDG_CACHE_HOME="$TMPDIR/cache" + mkdir -p "$HOME" "$XDG_CACHE_HOME" + export CL_SOURCE_REGISTRY="${clSourceRegistryFor}$PWD//:" + timeout 300 sbcl --script scripts/coverage.lisp + mkdir -p "$out" + cp -R coverage/. "$out/" + ''; + + docs = mkDocs pkgs; + } + ); + + checks = forEachSystem ( + system: + let + pkgs = pkgsFor system; + src = sourceFor pkgs; + in + { + # Structural parse gate over every tracked Lisp source: fails if + # any .lisp/.asd file is not a balanced S-expression document. + paredit-lint = paredit-cli.lib.${system}.mkLintCheck { + inherit src; + name = "cl-tty-kit-paredit-lint"; + }; + + # Hermetic equivalent of `sbcl --script scripts/test.lisp`. + test = pkgs.runCommand "cl-tty-kit-test" { nativeBuildInputs = [ pkgs.sbcl ]; } '' + cp -R ${src} source + chmod -R u+w source + cd source + export HOME="$TMPDIR/home" + export XDG_CACHE_HOME="$TMPDIR/cache" + mkdir -p "$HOME" "$XDG_CACHE_HOME" + export CL_SOURCE_REGISTRY="${clSourceRegistryFor}$PWD//:" + timeout 600 sbcl --non-interactive \ + --eval '(require :asdf)' \ + --eval '(asdf:load-asd (truename "cl-tty-kit.asd"))' \ + --eval '(asdf:test-system :cl-tty-kit)' + touch $out + ''; + + formatting = pkgs.runCommand "cl-tty-kit-nix-formatting" { nativeBuildInputs = [ pkgs.nixpkgs-fmt ]; } '' + nixpkgs-fmt --check ${./flake.nix} + touch $out + ''; + } + ); + devShells = forEachSystem ( system: let @@ -41,14 +218,21 @@ in { default = pkgs.mkShell { - # git is needed for `git submodule update --init` (vendor/cl-prolog, - # vendor/cl-weave -- see README "Installation"); sbcl brings sb-posix - # and sb-unicode as built-in contribs, so no separate Quicklisp - # bootstrap is required for the core system. + # sbcl brings sb-posix and sb-unicode as built-in contribs, so no + # separate Quicklisp bootstrap is required for the core system. + # paredit-cli is the structural refactoring tool for this repo's + # Lisp sources. git is kept for ordinary repository work. packages = [ pkgs.sbcl pkgs.git + pkgs.nixpkgs-fmt + paredit-cli.packages.${system}.default ]; + # The only place cl-prolog/cl-weave come from: cl-tty-kit.asd's + # :depends-on cannot resolve either without this. + shellHook = '' + export CL_SOURCE_REGISTRY="$PWD//:${clSourceRegistryFor}''${CL_SOURCE_REGISTRY:-}" + ''; }; } ); @@ -59,13 +243,12 @@ pkgs = pkgsFor system; in { - # Mirrors .github/workflows/ci.yml's verify/coverage/test steps, so - # `nix run .#test` (etc.), run from a checkout with submodules - # initialized, matches what CI actually runs. - test = scriptApp pkgs "cl-tty-kit-test" "test.lisp"; - verify = scriptApp pkgs "cl-tty-kit-verify" "verify.lisp"; - coverage = scriptApp pkgs "cl-tty-kit-coverage" "coverage.lisp"; - default = scriptApp pkgs "cl-tty-kit-test" "test.lisp"; + # Mirrors .github/workflows/ci.yml's nix job, so + # `nix run .#test` (etc.) matches what CI actually runs. + test = scriptApp pkgs "cl-tty-kit-test" "test.lisp" "Run the cl-tty-kit test suite"; + verify = scriptApp pkgs "cl-tty-kit-verify" "verify.lisp" "Run the full release gate: tests, examples, and the source-registry smoke"; + coverage = scriptApp pkgs "cl-tty-kit-coverage" "coverage.lisp" "Regenerate the sb-cover report under coverage/"; + default = scriptApp pkgs "cl-tty-kit-test" "test.lisp" "Run the cl-tty-kit test suite"; } ); }; diff --git a/src/input-decode-internals.lisp b/src/input-decode-internals.lisp index 1d6d0b5..2331438 100644 --- a/src/input-decode-internals.lisp +++ b/src/input-decode-internals.lisp @@ -42,6 +42,27 @@ (defun %copy-paste-buffer-string (pending-paste) (copy-seq pending-paste)) +(defun %normalize-paste-line-endings (string) + "Convert CRLF and lone CR line endings in STRING to LF. +A terminal that sends CR-terminated (or CRLF-terminated) lines inside a +bracketed paste would otherwise leave a raw CR in a collected :PASTE event's +payload, which most callers treating it as ordinary LF-delimited buffer text +do not want." + (with-output-to-string (out) + (loop with limit = (length string) + with index = 0 + while (< index limit) + for ch = (char string index) + do (cond + ((char= ch #\Return) + (write-char #\Newline out) + (incf index) + (when (and (< index limit) (char= (char string index) #\Newline)) + (incf index))) + (t + (write-char ch out) + (incf index)))))) + (defun %assert-decoder-buffer-size (decoder size) "Signal when SIZE would exceed DECODER's retained-state bound." (when (> size (input-decoder-max-pending decoder)) @@ -181,10 +202,12 @@ reverse-order accumulator that %COLLECT-PASTE-EVENTS threads through the loop." (:emit (cons (second action) events)) (:finish-paste - (push (%make-paste-event - (%copy-paste-buffer-string - (input-decoder-pending-paste decoder))) - events) + (let ((text (%copy-paste-buffer-string (input-decoder-pending-paste decoder)))) + (push (%make-paste-event + (if (input-decoder-normalize-paste-line-endings-p decoder) + (%normalize-paste-line-endings text) + text)) + events)) (setf (input-decoder-pending-paste decoder) nil) events) (:flush-paste diff --git a/src/input-decode.lisp b/src/input-decode.lisp index 7b0bad0..7ef38c5 100644 --- a/src/input-decode.lisp +++ b/src/input-decode.lisp @@ -16,10 +16,16 @@ Bracketed paste markers stay visible as :PASTE-START and :PASTE-END events. Malformed UTF-8 signals INVALID-UTF8-SEQUENCE." (values (%collect-plain-events (%input->string input) t))) -(defun make-input-decoder (&key collect-bracketed-paste (max-pending 4194304)) +(defun make-input-decoder (&key collect-bracketed-paste normalize-paste-line-endings + (max-pending 4194304)) "Create an incremental INPUT-DECODER. When COLLECT-BRACKETED-PASTE is true, completed paste blocks are emitted as a single :PASTE event instead of surfacing the surrounding marker events. +When NORMALIZE-PASTE-LINE-ENDINGS is also true, that :PASTE event's text has +CRLF and lone CR line endings converted to LF -- some terminals send CR- +terminated lines inside a bracketed paste, and callers that insert paste text +into an LF-delimited buffer usually want it pre-normalized rather than +re-implementing that scan themselves. MAX-PENDING bounds the still-undecoded tail (partial UTF-8, a held escape, or an open paste payload) the decoder will buffer across chunks, which keeps an unterminated sequence from an untrusted source from exhausting memory; exceeding @@ -27,6 +33,7 @@ it signals a TTY-KIT-ERROR." (unless (and (integerp max-pending) (not (minusp max-pending))) (error "MAX-PENDING must be a non-negative integer: ~S." max-pending)) (%make-input-decoder :collect-bracketed-paste-p collect-bracketed-paste + :normalize-paste-line-endings-p normalize-paste-line-endings :max-pending max-pending)) (defun %check-decoder-buffer (decoder) @@ -71,12 +78,9 @@ its decode signals INVALID-UTF8-SEQUENCE instead." (cond ((stringp input) (if (plusp (length (input-decoder-pending-octets decoder))) - (let ((prefix (%decoder-decode-octets decoder #() eof))) - (when (plusp (length prefix)) - (%assert-decoder-buffer-size - decoder - (+ (length prefix) (length input)))) - (concatenate 'string prefix input)) + (concatenate 'string + (%decoder-decode-octets decoder #() eof) + input) input)) ((%octet-input-p input) (%decoder-decode-octets decoder input eof)) diff --git a/src/input-state.lisp b/src/input-state.lisp index 94dbec9..b52c063 100644 --- a/src/input-state.lisp +++ b/src/input-state.lisp @@ -6,6 +6,7 @@ (pending-string "") (pending-octets #()) (collect-bracketed-paste-p nil) + (normalize-paste-line-endings-p nil) (pending-paste nil) (max-pending 4194304 :type (integer 0 *))) diff --git a/src/key-tables.lisp b/src/key-tables.lisp index c4f9fff..41284ea 100644 --- a/src/key-tables.lisp +++ b/src/key-tables.lisp @@ -175,4 +175,12 @@ (23 . :control-w) (24 . :control-x) (25 . :control-y) - (26 . :control-z))) + (26 . :control-z) + ;; The four C0 controls above the letter range that a US keyboard still + ;; reaches via Ctrl plus a punctuation key: FS/GS/RS/US. Ctrl-_ (31) is a + ;; common readline "undo" binding, so it is the most consequential of the + ;; four to recognize as a named event rather than an unprintable :CHARACTER. + (28 . :control-backslash) + (29 . :control-right-bracket) + (30 . :control-caret) + (31 . :control-underscore))) diff --git a/t/color.lisp b/t/color.lisp index 0a850f7..b038af9 100644 --- a/t/color.lisp +++ b/t/color.lisp @@ -107,6 +107,9 @@ (is (equal '(255 136 0) (multiple-value-list (parse-color "#ff8800")))) (is (equal '(1 2 3) (multiple-value-list (parse-color "rgb(1, 2, 3)")))) (is (equal '(1 2 3) (multiple-value-list (parse-color "rgb(1 2 3)")))) + ;; Trailing whitespace after the closing paren is tolerated, unlike other + ;; trailing content (see "rgb(1, 2, 3)junk" below). + (is (equal '(1 2 3) (multiple-value-list (parse-color "rgb(1, 2, 3) ")))) (signals (error c) (parse-color "rgb(1, 2, x)") (is c)) (signals (error c) (parse-color "rgb(256, 0, 0)") (is c)) (signals (error c) (parse-color "rgb(1234, 0, 0)") (is c)) diff --git a/t/format.lisp b/t/format.lisp index da75072..fa47b6e 100644 --- a/t/format.lisp +++ b/t/format.lisp @@ -67,7 +67,8 @@ ;; Accepts a vector too. (is (string= (%spark 0 7) (format-sparkline #(0 1)))) (signals-non-type-error (format-sparkline '(:bad))) - (signals-non-type-error (format-sparkline '(1 2) :min :low))) + (signals-non-type-error (format-sparkline '(1 2) :min :low)) + (signals-non-type-error (format-sparkline :not-a-sequence))) (defun %test-format-table () (is (equal '("a bb" "ccc d ") @@ -79,6 +80,9 @@ (is (equal '("a b") (format-table '(("a" "b")) :aligns '(:right :right)))) (signals-non-type-error (format-table :not-a-list)) + ;; A ROWS list whose element is not itself a list, as opposed to a row + ;; containing a non-string field (the next case below). + (signals-non-type-error (format-table '("not-a-row"))) (signals-non-type-error (format-table '((:bad)))) (signals-non-type-error (format-table '(("a")) :aligns :bad)) (signals-non-type-error (format-table '(("a")) :aligns '(:bad))) diff --git a/t/input-data.lisp b/t/input-data.lisp index e50b46f..e3a9d3a 100644 --- a/t/input-data.lisp +++ b/t/input-data.lisp @@ -14,18 +14,18 @@ (:character ,#\あ nil) (:character ,#\b nil)) "Mixed ASCII and UTF-8 input should preserve event order.") - (,(concatenate 'string (string #\Esc) "[200~") + (,(%esc "[200~") ((:special :paste-start nil)) "Bracketed paste start should decode as a special event.") - (,(concatenate 'string (string #\Esc) "[201~") + (,(%esc "[201~") ((:special :paste-end nil)) "Bracketed paste end should decode as a special event.") - (,(concatenate 'string (string #\Esc) "[u") + (,(%esc "[u") ((:special :escape nil) (:character ,#\[ nil) (:character ,#\u nil)) "An empty CSI-u body falls back to ordinary decoding instead of crashing.") - (,(concatenate 'string (string #\Esc) "[" (make-string 19 :initial-element #\9) "u") + (,(%esc "[" (make-string 19 :initial-element #\9) "u") ((:special :escape nil) (:character ,#\[ nil) ,@(loop repeat 19 collect (list :character #\9 nil)) @@ -37,7 +37,7 @@ ordinary decoding instead of parsing an unbounded bignum."))) `(((,(string #\Esc) "[A") ((:special :up nil)) "CSI sequences should survive chunk boundaries.") - ((,(concatenate 'string (string #\Esc) "O") "P") + ((,(%esc "O") "P") ((:special :f1 nil)) "SS3 sequences should survive chunk boundaries.") ((,(string #\Esc) "z") @@ -57,47 +57,43 @@ across the chunk boundary.") ((:character ,#\😀 nil) (:character ,#\! nil)) "Four-byte UTF-8 sequences should survive chunk boundaries.") - ((,(concatenate 'string (string #\Esc) "[20") + ((,(%esc "[20") "0~he" ,(concatenate 'string "llo" (string #\Esc) "[201~")) ((:paste "hello" nil)) "Bracketed paste should aggregate across chunk boundaries." :collect-bracketed-paste t) - ((,(concatenate 'string (string #\Esc) "[200~") + ((,(%esc "[200~") "hello" - ,(concatenate 'string (string #\Esc) "[201~")) + ,(%esc "[201~")) ((:paste "hello" nil)) "Bracketed paste should aggregate whole payload chunks." :collect-bracketed-paste t) - ((,(concatenate 'string - (string #\Esc) - "[200~abc" + ((,(%esc "[200~abc" (string #\Esc) "[20") "1~") ((:paste "abc" nil)) "Bracketed paste terminators should survive chunk boundaries." :collect-bracketed-paste t) - ((,(concatenate 'string (string #\Esc) "[200~") + ((,(%esc "[200~") #(227 129) #(130 98 27 91 50 48 49 126)) ((:paste "あb" nil)) "Bracketed paste should preserve UTF-8 payloads across chunks." :collect-bracketed-paste t) - ((,(concatenate 'string - (string #\Esc) - "[200~hello" + ((,(%esc "[200~hello" (string #\Esc) "[201~x")) ((:paste "hello" nil) (:character ,#\x nil)) "Trailing events should remain after aggregated paste payloads." :collect-bracketed-paste t) - ((,(concatenate 'string (string #\Esc) "[105;") + ((,(%esc "[105;") "6u") ((:character ,#\i (:control :shift))) "CSI-u sequences should survive chunk boundaries.") - ((,(concatenate 'string (string #\Esc) "[99999999") + ((,(%esc "[99999999") "u") ((:special :escape nil) (:character ,#\[ nil) @@ -117,14 +113,12 @@ across the chunk boundary.") (#(194 162 33) nil) (#(97 227 129 130 98) nil) (#(240 159 152 128 33) nil) - (,(concatenate 'string (string #\Esc) "[A") nil) - (,(concatenate 'string (string #\Esc) "OP") nil) - (,(concatenate 'string (string #\Esc) "[1;aC") nil) - (,(concatenate 'string (string #\Esc) "[105;6u") nil) - (,(concatenate 'string (string #\Esc) "[99999999u") nil) - (,(concatenate 'string - (string #\Esc) - "[200~hello" + (,(%esc "[A") nil) + (,(%esc "OP") nil) + (,(%esc "[1;aC") nil) + (,(%esc "[105;6u") nil) + (,(%esc "[99999999u") nil) + (,(%esc "[200~hello" (string #\Esc) "[201~x") (:collect-bracketed-paste t)))) diff --git a/t/input.lisp b/t/input.lisp index a40ef12..955f827 100644 --- a/t/input.lisp +++ b/t/input.lisp @@ -141,7 +141,7 @@ (signals (error c) (make-input-decoder :max-pending -1) (is c)) (signals (error c) (make-input-decoder :max-pending 1.5) (is c)) (let ((decoder (make-input-decoder :collect-bracketed-paste t :max-pending 8))) - (decode-input-chunk decoder (concatenate 'string (string #\Esc) "[200~")) + (decode-input-chunk decoder (%esc "[200~")) (signals (cl-tty-kit::input-buffer-exceeded condition) (decode-input-chunk decoder "0123456789") (is (= 8 (cl-tty-kit::input-buffer-exceeded-limit condition))) @@ -155,30 +155,67 @@ (is (= 2 (cl-tty-kit::input-buffer-exceeded-limit condition))) (is (= 3 (cl-tty-kit::input-buffer-exceeded-size condition))))) (let ((decoder (make-input-decoder :max-pending 4))) - (is (null (decode-input-chunk decoder (concatenate 'string - (string #\Esc) - "[")))) + (is (null (decode-input-chunk decoder (%esc "[")))) (signals (cl-tty-kit::input-buffer-exceeded condition) (decode-input-chunk decoder "123") (is (= 4 (cl-tty-kit::input-buffer-exceeded-limit condition))) (is (= 5 (cl-tty-kit::input-buffer-exceeded-size condition))))) (let ((decoder (make-input-decoder :collect-bracketed-paste t)) (payload (make-string 128 :initial-element #\x))) - (decode-input-chunk decoder (concatenate 'string (string #\Esc) "[200~")) + (decode-input-chunk decoder (%esc "[200~")) (loop repeat 32 do (decode-input-chunk decoder "xxxx")) (%assert-event-signatures= (decode-input-chunk decoder - (concatenate 'string (string #\Esc) "[201~") + (%esc "[201~") :eof t) `((:paste ,payload nil)) "Split bracketed paste payloads should emit the accumulated text once.")) + (let ((decoder (make-input-decoder :collect-bracketed-paste t + :normalize-paste-line-endings t))) + (%assert-event-signatures= + (decode-input-chunk + decoder + (%esc "[200~" + "line1" (string #\Return) (string #\Newline) + "line2" (string #\Return) + "line3" + (string #\Esc) "[201~") + :eof t) + `((:paste ,(format nil "line1~%line2~%line3") nil)) + "NORMALIZE-PASTE-LINE-ENDINGS should convert CRLF and lone CR to LF.")) + (let ((decoder (make-input-decoder :collect-bracketed-paste t))) + (%assert-event-signatures= + (decode-input-chunk + decoder + (%esc "[200~" + "a" (string #\Return) (string #\Newline) "b" + (string #\Esc) "[201~") + :eof t) + `((:paste ,(concatenate 'string "a" (string #\Return) (string #\Newline) "b") + nil)) + "Without NORMALIZE-PASTE-LINE-ENDINGS, CR is preserved verbatim.")) (let* ((decoder (make-input-decoder :max-pending 2048)) - (input (concatenate 'string - (string #\Esc) - "[" + (input (%esc "[" (make-string 1025 :initial-element #\1)))) (is (decode-input-chunk decoder input)) - (is (null (flush-input-decoder decoder))))) + (is (null (flush-input-decoder decoder)))) + (let ((decoder (make-input-decoder))) + (is (null (decode-input-chunk decoder #(227 129)))) + (%assert-event-signatures= + (decode-input-chunk decoder "x") + '((:character #\x nil)) + "A string chunk fed while UTF-8 octets are still pending should decode normally, leaving the incomplete octets buffered.") + (%assert-event-signatures= + (decode-input-chunk decoder #(130) :eof t) + `((:character ,(code-char #x3042) nil)) + "Completing the pending octets afterward should recover the buffered character.")) + (let ((decoder (make-input-decoder))) + (is (null (decode-input-chunk decoder #(227 129)))) + (%assert-invalid-utf8-case + (lambda () (decode-input-chunk decoder "x" :eof t)) + 0 + :truncated-sequence + "A final string chunk should force any pending octets through the truncated-sequence fallback."))) (defun %test-streaming-input-cases () (do-test-case-bind (case +streaming-input-cases+ @@ -195,15 +232,11 @@ '((:special :escape nil)) "Flushing a pending escape should emit an escape event.") (let ((decoder (make-input-decoder))) - (is (null (decode-input-chunk decoder (concatenate 'string - (string #\Esc) - "[")))) + (is (null (decode-input-chunk decoder (%esc "[")))) (let ((events (decode-input-chunk decoder "x" :eof t))) (is (equal (%event-signatures-of events) (%event-signatures-of - (decode-input (concatenate 'string - (string #\Esc) - "[x"))))))) + (decode-input (%esc "[x"))))))) (let ((decoder (make-input-decoder))) (is (null (decode-input-chunk decoder #(227 129)))) (%assert-invalid-utf8-case @@ -223,16 +256,14 @@ (let ((decoder (make-input-decoder))) (signals (error c) (decode-input-chunk decoder 42) (is c))) (%assert-flush-case - (list (concatenate 'string (string #\Esc) "[200~ab")) + (list (%esc "[200~ab")) `((:special :paste-start nil) (:character ,#\a nil) (:character ,#\b nil)) "Flushing an unterminated paste should fall back to ordinary decoding." :collect-bracketed-paste t) (%assert-chunk-case - (list (concatenate 'string - (string #\Esc) - "[200~abc" + (list (%esc "[200~abc" (string #\Esc) "[2") "0" @@ -242,9 +273,7 @@ (:character ,#\z nil)) "Incremental paste terminator detection should preserve following input." :collect-bracketed-paste t) - (let* ((input (concatenate 'string - (string #\Esc) - "[200~abc" + (let* ((input (%esc "[200~abc" (string #\Esc) "[2")) (decoder (make-input-decoder :collect-bracketed-paste t))) @@ -257,9 +286,7 @@ (do-test-case-bind (case +streaming-equivalence-cases+ (input options)) (apply #'%assert-all-two-way-streaming-splits input options)) (%assert-streaming-decode-equivalent - (concatenate 'string - (string #\Esc) - "[200~hello" + (%esc "[200~hello" (string #\Esc) "[201~x") '(1 1 2 3 4 2 2 1 1 1) diff --git a/t/keys.lisp b/t/keys.lisp index 7d5b5ce..63c2c34 100644 --- a/t/keys.lisp +++ b/t/keys.lisp @@ -1,89 +1,96 @@ (in-package #:cl-tty-kit/test) +(defun %esc (&rest suffix-parts) + "Concatenate an ESC character with SUFFIX-PARTS, the shared building block +behind every literal terminal escape sequence these tests construct." + (apply #'concatenate 'string (string #\Esc) suffix-parts)) + (defparameter +single-decode-cases+ `(("a" :character #\a nil) - (,(concatenate 'string (string #\Esc) "[A") :special :up nil) - (,(concatenate 'string (string #\Esc) "[1;5C") :special :right (:control)) - (,(concatenate 'string (string #\Esc) "[3~") :special :delete nil) - (,(concatenate 'string (string #\Esc) "[5~") :special :page-up nil) - (,(concatenate 'string (string #\Esc) "[15~") :special :f5 nil) - (,(concatenate 'string (string #\Esc) "[105;6u") + (,(%esc "[A") :special :up nil) + (,(%esc "[1;5C") :special :right (:control)) + (,(%esc "[3~") :special :delete nil) + (,(%esc "[5~") :special :page-up nil) + (,(%esc "[15~") :special :f5 nil) + (,(%esc "[105;6u") :character #\i (:control :shift)) - (,(concatenate 'string (string #\Esc) "[57363;3u") + (,(%esc "[57363;3u") :special :menu (:alt)) - (,(concatenate 'string (string #\Esc) "[57358u") + (,(%esc "[57358u") :special :caps-lock nil) - (,(concatenate 'string (string #\Esc) "[57361;6u") + (,(%esc "[57361;6u") :special :print-screen (:control :shift)) - (,(concatenate 'string (string #\Esc) "[57414u") + (,(%esc "[57414u") :special :kp-enter nil) - (,(concatenate 'string (string #\Esc) "[57429u") + (,(%esc "[57429u") :special :kp-delete nil) - (,(concatenate 'string (string #\Esc) "[57364;2u") + (,(%esc "[57364;2u") :special :f13 (:shift)) - (,(concatenate 'string (string #\Esc) "[57386u") + (,(%esc "[57386u") :special :f35 nil) - (,(concatenate 'string (string #\Esc) "[57426;5u") + (,(%esc "[57426;5u") :special :kp-home (:control)) - (,(concatenate 'string (string #\Esc) "[57447u") + (,(%esc "[57447u") :special :media-track-next nil) - (,(concatenate 'string (string #\Esc) "[57442;4u") + (,(%esc "[57442;4u") :special :media-play-pause (:alt :shift)) - (,(concatenate 'string (string #\Esc) "[57450u") + (,(%esc "[57450u") :special :lower-volume nil) - (,(concatenate 'string (string #\Esc) "[57458u") + (,(%esc "[57458u") :special :left-meta nil) - (,(concatenate 'string (string #\Esc) "[57460;3u") + (,(%esc "[57460;3u") :special :right-control (:alt)) - (,(concatenate 'string (string #\Esc) "[57462;5u") + (,(%esc "[57462;5u") :special :right-super (:control)) - (,(concatenate 'string (string #\Esc) "[200~") + (,(%esc "[200~") :special :paste-start nil) - (,(concatenate 'string (string #\Esc) "[201~") + (,(%esc "[201~") :special :paste-end nil) - (,(concatenate 'string (string #\Esc) "[x") + (,(%esc "[x") :special :unknown-csi nil) - (,(concatenate 'string (string #\Esc) "[999~") + (,(%esc "[999~") :special :unknown-csi nil) - (,(concatenate 'string (string #\Esc) "[Z") :special :backtab nil) - (,(concatenate 'string (string #\Esc) "x") :character #\x (:alt)) - (,(concatenate 'string (string #\Esc) "OA") :special :up nil) - (,(concatenate 'string (string #\Esc) "OP") :special :f1 nil) - (,(concatenate 'string (string #\Esc) "OS") :special :f4 nil) + (,(%esc "[Z") :special :backtab nil) + (,(%esc "x") :character #\x (:alt)) + (,(%esc "OA") :special :up nil) + (,(%esc "OP") :special :f1 nil) + (,(%esc "OS") :special :f4 nil) (,(string (code-char 3)) :special :control-c nil) + (,(string (code-char 28)) :special :control-backslash nil) + (,(string (code-char 29)) :special :control-right-bracket nil) + (,(string (code-char 30)) :special :control-caret nil) + (,(string (code-char 31)) :special :control-underscore nil) (,(string #\Return) :special :enter nil) (,(string #\Tab) :special :tab nil) (,(string #\Rubout) :special :backspace nil))) (defparameter +decode-key-sequence-cases+ - (list (list (concatenate 'string (string #\Esc) "[") + (list (list (%esc "[") :special :escape nil 1) (list #(97) :character #\a nil 1) (list (concatenate 'string "zz" (string #\Esc) "[1;5C") :special :right '(:control) 6 :start 2) (list (concatenate 'string "zz" (string #\Esc) "x") :character #\x '(:alt) 2 :start 2) - (list (concatenate 'string (string #\Esc) "[1;aC") + (list (%esc "[1;aC") :special :escape nil 1) (list (concatenate 'string "zz" (string #\Esc) "O") :special :escape nil 1 :start 2) - (list (concatenate 'string (string #\Esc) "[99999999u") + (list (%esc "[99999999u") :special :escape nil 1) - (list (concatenate 'string (string #\Esc) "[" - (make-string 19 :initial-element #\9) "u") + (list (%esc "[" (make-string 19 :initial-element #\9) "u") :special :escape nil 1))) (defparameter +decoded-event-code-cases+ - (list (list (concatenate 'string (string #\Esc) "[1;aC") + (list (list (%esc "[1;aC") '(:escape #\[ #\1 #\; #\a #\C)) - (list (concatenate 'string (string #\Esc) "[99999999u") + (list (%esc "[99999999u") '(:escape #\[ #\9 #\9 #\9 #\9 #\9 #\9 #\9 #\9 #\u)) - (list (concatenate 'string (string #\Esc) "[" - (make-string 19 :initial-element #\9) "u") + (list (%esc "[" (make-string 19 :initial-element #\9) "u") (append '(:escape #\[) (make-list 19 :initial-element #\9) '(#\u))) - (list (concatenate 'string (string #\Esc) "O") + (list (%esc "O") '(:escape #\O)))) (defun %key-event-signature (event) @@ -235,6 +242,13 @@ (decode-color-report (format nil "~C]11;notrgb~C\\" #\Esc #\Esc)) (declare (ignore r g b)) (is (= 0 consumed))) + ;; A complete report missing the second "/" separator (only one channel + ;; boundary, so R/G/B cannot be split) is declined, as opposed to missing + ;; the terminator entirely (the case above). + (multiple-value-bind (r g b consumed) + (decode-color-report (format nil "~C]10;rgb:ff/00~C\\" #\Esc #\Esc)) + (declare (ignore r g b)) + (is (= 0 consumed))) ;; Invalid offsets are declined without signaling. (multiple-value-bind (r g b consumed) (decode-color-report (format nil "~C]10;rgb:ff/00/00~C" #\Esc (code-char 7)) @@ -259,7 +273,7 @@ (is (= 0 consumed)))) (defun %csi (params final) - (concatenate 'string (string #\Esc) "[" params (string final))) + (%esc "[" params (string final))) (defun %test-kitty-and-f-keys () ;; Kitty CSI-u event types: MODIFIER:EVENT. 'a' = 97; event 3 = release. diff --git a/t/mouse.lisp b/t/mouse.lisp index ef1c444..4cad201 100644 --- a/t/mouse.lisp +++ b/t/mouse.lisp @@ -11,52 +11,47 @@ (is (= ,y (mouse-event-y ,event))) (is (equal ,modifiers (mouse-event-modifiers ,event))))) -(defun %test-mouse-basic () - ;; Left press at terminal (1,1) reports 0-based (0,0) and consumes the report. - (multiple-value-bind (event consumed) - (decode-mouse-sequence (%sgr-mouse 0 1 1 #\M)) - (%mouse-is (event) :button :left :action :press :x 0 :y 0 :modifiers nil) - (is (= 9 consumed))) - ;; Release (trailing `m'). - (multiple-value-bind (event consumed) - (decode-mouse-sequence (%sgr-mouse 0 5 3 #\m)) - (declare (ignore consumed)) - (%mouse-is (event) :button :left :action :release :x 4 :y 2 :modifiers nil)) - ;; Right and middle buttons. - (%mouse-is ((decode-mouse-sequence (%sgr-mouse 2 10 20 #\M))) - :button :right :action :press :x 9 :y 19 :modifiers nil) - (%mouse-is ((decode-mouse-sequence (%sgr-mouse 1 2 2 #\M))) - :button :middle :action :press :x 1 :y 1 :modifiers nil) - ;; Low button bits of 3 are not a real button: reported as :NONE, still a press. - (%mouse-is ((decode-mouse-sequence (%sgr-mouse 3 5 5 #\M))) - :button :none :action :press :x 4 :y 4 :modifiers nil)) - -(defun %test-mouse-wheel-and-motion () - (%mouse-is ((decode-mouse-sequence (%sgr-mouse 64 5 5 #\M))) - :button :wheel-up :action :scroll :x 4 :y 4 :modifiers nil) - (%mouse-is ((decode-mouse-sequence (%sgr-mouse 65 5 5 #\M))) - :button :wheel-down :action :scroll :x 4 :y 4 :modifiers nil) - ;; Horizontal wheel (buttons 66/67). - (%mouse-is ((decode-mouse-sequence (%sgr-mouse 66 5 5 #\M))) - :button :wheel-left :action :scroll :x 4 :y 4 :modifiers nil) - (%mouse-is ((decode-mouse-sequence (%sgr-mouse 67 5 5 #\M))) - :button :wheel-right :action :scroll :x 4 :y 4 :modifiers nil) - ;; Motion with the left button held is a drag; without a button it is a move. - (%mouse-is ((decode-mouse-sequence (%sgr-mouse 32 3 3 #\M))) - :button :left :action :drag :x 2 :y 2 :modifiers nil) - (%mouse-is ((decode-mouse-sequence (%sgr-mouse 35 3 3 #\M))) - :button :none :action :move :x 2 :y 2 :modifiers nil)) +(defparameter +mouse-decode-cases+ + '((0 1 1 #\M :left :press 0 0 nil + "Left press at terminal (1,1) reports 0-based (0,0)") + (0 5 3 #\m :left :release 4 2 nil + "Release (trailing `m')") + (2 10 20 #\M :right :press 9 19 nil + "Right button") + (1 2 2 #\M :middle :press 1 1 nil + "Middle button") + (3 5 5 #\M :none :press 4 4 nil + "Low button bits of 3 are not a real button: reported as :NONE, still a press") + (64 5 5 #\M :wheel-up :scroll 4 4 nil + "Wheel up") + (65 5 5 #\M :wheel-down :scroll 4 4 nil + "Wheel down") + (66 5 5 #\M :wheel-left :scroll 4 4 nil + "Horizontal wheel left (button 66)") + (67 5 5 #\M :wheel-right :scroll 4 4 nil + "Horizontal wheel right (button 67)") + (32 3 3 #\M :left :drag 2 2 nil + "Motion with the left button held is a drag") + (35 3 3 #\M :none :move 2 2 nil + "Motion without a button held is a move") + (4 1 1 #\M :left :press 0 0 (:shift) + "Shift modifier") + (8 1 1 #\M :left :press 0 0 (:alt) + "Alt (button bit 8)") + (20 1 1 #\M :left :press 0 0 (:control :shift) + "Shift (4) + Control (16), normalized and sorted")) + "Each case is (CB CX CY FINAL BUTTON ACTION X Y MODIFIERS MESSAGE): the SGR +mouse report parameters %SGR-MOUSE builds, and the MOUSE-EVENT DECODE-MOUSE- +SEQUENCE must decode it into.") -(defun %test-mouse-modifiers () - (%mouse-is ((decode-mouse-sequence (%sgr-mouse 4 1 1 #\M))) - :button :left :action :press :x 0 :y 0 :modifiers '(:shift)) - ;; Alt (button bit 8) on a left press. - (%mouse-is ((decode-mouse-sequence (%sgr-mouse 8 1 1 #\M))) - :button :left :action :press :x 0 :y 0 :modifiers '(:alt)) - ;; Shift (4) + Control (16) on a left press, normalized and sorted. - (%mouse-is ((decode-mouse-sequence (%sgr-mouse 20 1 1 #\M))) - :button :left :action :press :x 0 :y 0 - :modifiers '(:control :shift))) +(defun %test-mouse-decode-cases () + (do-test-case-bind (case +mouse-decode-cases+ + (cb cx cy final button action x y modifiers message)) + (let ((report (%sgr-mouse cb cx cy final))) + (multiple-value-bind (event consumed) (decode-mouse-sequence report) + (%mouse-is (event) :button button :action action :x x :y y + :modifiers modifiers) + (is (= (length report) consumed) message))))) (defun %test-mouse-partial-and-offset () ;; A report missing its terminator does not decode. @@ -139,9 +134,7 @@ :x 0 :y 0 :modifiers nil)))) (defun test-mouse () - (%test-mouse-basic) - (%test-mouse-wheel-and-motion) - (%test-mouse-modifiers) + (%test-mouse-decode-cases) (%test-mouse-partial-and-offset) (%test-mouse-input-integration) t) diff --git a/t/package-data.lisp b/t/package-data.lisp index f8b9fe1..b1758a4 100644 --- a/t/package-data.lisp +++ b/t/package-data.lisp @@ -8,7 +8,7 @@ (:homepage . "https://github.com/nerima-lisp/cl-tty-kit") (:bug-tracker . "https://github.com/nerima-lisp/cl-tty-kit/issues") (:source-control . "git https://github.com/nerima-lisp/cl-tty-kit.git") - (:version . "0.6.0"))) + (:version . "1.0.0"))) (defparameter +expected-external-symbols+ '("TTY-KIT-ERROR" diff --git a/t/properties.lisp b/t/properties.lisp index 1ae0e70..c756f96 100644 --- a/t/properties.lisp +++ b/t/properties.lisp @@ -2,7 +2,7 @@ (:use #:cl #:cl-tty-kit) (:shadowing-import-from #:cl-weave #:describe) (:import-from #:cl-weave - #:expect #:it-property #:run-all) + #:expect #:it #:it-property #:run-all) (:export #:run-tests)) (in-package #:cl-tty-kit/property-tests) @@ -127,6 +127,21 @@ do (expect (<= (length (render-diff current previous)) (length (render-screen current))))))) +(describe "render-diff stays within an allocation budget" + ;; A regression guard, not a correctness check: a worst-case 80x24 full + ;; repaint conses well under 400KB on this project's supported SBCL + ;; versions, so 2MB (5x headroom) tolerates version-to-version SBCL + ;; allocator drift while still failing loudly on an accidental O(n^2) + ;; blowup or a diff that stops discarding unchanged cells. + (it "an 80x24 full repaint allocates under 2MB" + (let* ((previous (make-screen 80 24)) + (current (screen-copy previous))) + (dotimes (y 24) + (dotimes (x 80) + (screen-put-cell current x y (code-char (+ 33 (mod (+ x y) 90)))))) + (expect (lambda () (render-diff current previous)) + :to-allocate-under (* 2 1024 1024))))) + (defun run-tests () "Run every property block registered above and return true iff all passed." (run-all :reporter :spec)) diff --git a/t/pty.lisp b/t/pty.lisp index 7e5e7df..73e35d2 100644 --- a/t/pty.lisp +++ b/t/pty.lisp @@ -14,6 +14,18 @@ finally (return (and chunks (apply #'concatenate 'string (nreverse chunks))))))) +#+sbcl +(defun inherited-environment () + "The current process environment, for a child that must resolve a binary on PATH. +MAKE-PTY forwards :ENVIRONMENT straight to SB-EXT:RUN-PROGRAM, where NIL means an +*empty* environment rather than an inherited one -- so a PTY child spawned with +the default has no PATH, and any `sh -c' body calling a non-builtin exits 127. +That stays invisible on a developer machine because sh then falls back to a +compiled-in default PATH that happens to contain the binary; inside the Nix build +sandbox, and therefore in CI, it does not. Prefer shell builtins where possible +and this environment where a real binary is genuinely required." + (sb-ext:posix-environ)) + #+sbcl (defmacro with-function-overrides ((&rest bindings) &body body) (let ((saved-bindings @@ -184,6 +196,27 @@ (is (eq pty (close-pty pty))) (is (null (pty-process pty))) (is (null (pty-stream pty)))) + ;; /bin/sh reads stdin, so closing its PTY stream alone (SIGPIPE/EOF) ends + ;; it before %CLOSE-PTY-PROCESS ever needs to send a real signal -- the two + ;; cases above never exercise %TERMINATE-PTY-PROCESS's actual SIGTERM path. + ;; sleep(1) ignores stdin entirely, so it survives the stream close and + ;; forces %CLOSE-PTY-PROCESS through %WAIT-FOR-PROCESS-EXIT returning NIL + ;; once, then %TERMINATE-PTY-PROCESS's real SIGTERM successfully ending it. + ;; + ;; `exec sleep' through /bin/sh, rather than spawning "/bin/sleep" directly: + ;; /bin/sh is the only absolute path the Nix build sandbox provides, and + ;; sleep(1) lives in coreutils on PATH there, not at /bin/sleep. The `exec' + ;; matters too: it replaces the shell, so nothing is left reading stdin, + ;; which is the entire point of this case. INHERITED-ENVIRONMENT is what + ;; actually puts coreutils on PATH -- see its docstring; without it the + ;; shell cannot find sleep and exits 127 instead of blocking. + (let* ((pty (make-pty :program "/bin/sh" + :args '("-c" "exec sleep 5") + :environment (inherited-environment))) + (process (pty-process pty))) + (is (sb-ext:process-alive-p process)) + (is (eq pty (close-pty pty))) + (is (not (sb-ext:process-alive-p process)))) (let* ((stream (make-string-input-stream "abc")) (pty (cl-tty-kit::%make-pty :process nil :stream stream))) (is (eq pty (close-pty pty))) @@ -233,8 +266,16 @@ (pty-write closed-pty "x"))) (close-pty vector-pty)) (close-pty write-pty)) + ;; `printf' and `read' are both shell builtins, so this needs no PATH (see + ;; INHERITED-ENVIRONMENT). The trailing `read' is what keeps the child alive + ;; while the parent drains the master side: an earlier `sleep 0.05' here was + ;; a timing bet that the child outlives the read loop, and it lost that bet + ;; whenever sleep(1) was unavailable and the shell exited immediately -- + ;; a dead child makes the next master-side read fail with EIO rather than + ;; return "hello". Blocking on stdin instead removes the race entirely: the + ;; child now lives until CLOSE-PTY closes the master and it sees EOF. (let ((pty (make-pty :program "/bin/sh" - :args '("-c" "printf hello; sleep 0.05")))) + :args '("-c" "printf hello; read ignored")))) (is (pty-process pty)) (is (streamp (pty-stream pty))) (let ((output (read-pty-until pty @@ -314,6 +355,22 @@ :stream (make-string-output-stream)))) (signals-pty-operation-failed (:fd fdless "PTY operation FD failed") (pty-fd fdless))) + ;; A stream backed by a negative fd (SB-SYS:FD-STREAM-FD is -1 once its + ;; underlying descriptor has itself been closed out from under a still-live + ;; stream object) is declined the same way a non-integer fd is above, not + ;; treated as a valid descriptor. + (let* ((rigged (open "/dev/null" :direction :output :if-exists :append)) + (pty (cl-tty-kit::%make-pty :process nil :stream rigged)) + (real-fd (sb-sys:fd-stream-fd rigged))) + (unwind-protect + (progn + (setf (sb-sys:fd-stream-fd rigged) -1) + (signals-pty-operation-failed (:fd pty "PTY operation FD failed") + (pty-fd pty))) + ;; Restore the real descriptor before closing, or CLOSE would try to + ;; close fd -1 and leak the one /dev/null actually opened. + (setf (sb-sys:fd-stream-fd rigged) real-fd) + (close rigged))) ;; FR-002: byte-transparent octet round-trip over a real pipe. The payload ;; carries a UTF-8 high-byte sequence (#xE2 #x9C #x93) plus NUL and ESC control ;; bytes, all of which must survive verbatim with no character decoding. @@ -424,6 +481,20 @@ (fd-write-octets 987654 (make-array 1 :element-type '(unsigned-byte 8) :initial-element 1))) + ;; FR-002: fd-write-octets retries silently when unix-write is interrupted by + ;; a signal (EINTR), the retry path a real syscall almost never exercises. + (let ((call-count 0)) + (with-function-overrides + ((sb-unix:unix-write + (lambda (fd octets offset len) + (declare (ignore fd octets offset)) + (incf call-count) + (if (= call-count 1) + (values nil sb-unix:eintr) + (values len nil))))) + (is (= 3 (fd-write-octets 0 (make-array 3 :element-type '(unsigned-byte 8) + :initial-element 1)))) + (is (= 2 call-count)))) t) #-sbcl diff --git a/t/raw-mode.lisp b/t/raw-mode.lisp index 6c316a0..c2b724a 100644 --- a/t/raw-mode.lisp +++ b/t/raw-mode.lisp @@ -204,4 +204,10 @@ (setf failed t))))) (close-pty pty) (is failed))) + ;; %SB-POSIX-SYMBOL is a portability guard against an SB-POSIX symbol + ;; renamed or removed out from under this code; a name that has never + ;; existed there exercises the same path deterministically. + (signals (error condition) + (cl-tty-kit::%sb-posix-symbol "DEFINITELY-NOT-A-REAL-SB-POSIX-SYMBOL") + (is (search "SB-POSIX symbol" (format nil "~A" condition)))) t) diff --git a/t/screen-mutation.lisp b/t/screen-mutation.lisp new file mode 100644 index 0000000..35f7d96 --- /dev/null +++ b/t/screen-mutation.lisp @@ -0,0 +1,422 @@ +(in-package #:cl-tty-kit/test) + +;;; -------------------------------------------------------------------------- +;;; Mutation, copy-on-write, and error-path coverage for SCREEN and CELL. +;;; +;;; Split out of t/screen.lisp, which keeps the read-oriented API tests +;;; (fill, copy, row-string, scroll, blit, crop, ...); this file groups the +;;; tests that share a theme instead -- every mutating SCREEN operation's +;;; effect on cell state, the copy-on-write contract CELL/SCREEN make about +;;; caller-owned style lists, and the bounds/dimension error paths both +;;; halves of the API share. Uses BOUNDS-ERROR-IS/DIMENSIONS-ERROR-IS, +;;; defined in t/screen.lisp, loaded first. +;;; -------------------------------------------------------------------------- + +(defun %test-screen-mutation-sequence () + (let ((screen (make-screen 3 2))) + (is (= 3 (screen-width screen))) + (is (= 2 (screen-height screen))) + (screen-cells-is screen + (0 0 #\Space)) + + (screen-put-cell screen 1 0 #\X) + (screen-cells-is screen + (1 0 #\X)) + + (let ((resized (screen-resize screen 4 3 :initial-cell #\.))) + (is (eq screen resized)) + (is (= 4 (screen-width screen))) + (is (= 3 (screen-height screen))) + (screen-cells-is screen + (0 0 #\Space) + (1 0 #\X) + (3 2 #\.))) + + (screen-put-cell screen 3 2 #\Z :style '(:bold)) + (screen-resize screen 2 1) + (is (= 2 (screen-width screen))) + (is (= 1 (screen-height screen))) + (screen-cells-is screen + (0 0 #\Space) + (1 0 #\X)) + + (let ((template (make-cell :char #\R :style '(:underline)))) + (screen-resize screen 3 2 :initial-cell template) + (setf (cell-char template) #\S + (cell-style template) '(:italic)) + (screen-cells-is screen + (2 1 #\R :style '(:underline)))) + + (screen-clear screen) + (screen-cells-is screen + (1 0 #\Space)) + (screen-clear screen :cell #\.) + (screen-cells-is screen + (0 0 #\.) + (2 1 #\.)) + (screen-clear screen :cell nil) + (screen-cells-is screen + (0 0 #\Space) + (2 1 #\Space)) + + (let ((source (make-cell :char #\A :style '(:bold)))) + (screen-put-cell screen 0 1 source) + (setf (cell-char source) #\B + (cell-style source) '(:italic)) + (screen-cells-is screen + (0 1 #\A :style '(:bold)))) + + (setf (screen-cell screen 2 1) #\T) + (screen-cells-is screen + (2 1 #\T)) + + (let ((source (make-cell :char #\C :style '(:bold)))) + (screen-put-cell screen 1 1 source :style '(:italic)) + (screen-cells-is screen + (1 1 #\C :style '(:italic)))) + + (let ((source (make-cell :char #\D :style '(:bold)))) + (screen-put-cell screen 2 0 source :style nil) + (screen-cells-is screen + (2 0 #\D))) + + (let ((written (screen-write-string screen 0 0 "abc"))) + (is (eq screen written)) + (screen-cells-is screen + (0 0 #\a) + (1 0 #\b) + (2 0 #\c))) + + (screen-write-string screen 0 1 "xy" :style '(:underline)) + (screen-cells-is screen + (0 1 #\x :style '(:underline)) + (1 1 #\y :style '(:underline))) + + (let ((filled (screen-fill-rect screen 0 0 2 2 #\*))) + (is (eq screen filled)) + (screen-cells-is screen + (0 0 #\*) + (1 0 #\*) + (0 1 #\*) + (1 1 #\*))) + + (let ((source (make-cell :char #\Q :style '(:bold)))) + (screen-fill-rect screen 1 0 2 1 source) + (setf (cell-char source) #\R + (cell-style source) '(:italic)) + (screen-cells-is screen + (1 0 #\Q :style '(:bold)) + (2 0 #\Q :style '(:bold)))) + + (let ((source (make-cell :char #\S :style '(:bold)))) + (screen-fill-rect screen 0 1 2 1 source :style '(:italic)) + (screen-cells-is screen + (0 1 #\S :style '(:italic)) + (1 1 #\S :style '(:italic)))) + + (screen-write-string screen 0 0 "prefix" :start 2 :end 5) + (screen-cells-is screen + (0 0 #\e) + (1 0 #\f) + (2 0 #\i)) + + (let ((source (make-cell :char #\Z :style '(:bold)))) + (screen-clear screen :cell source) + (setf (cell-char source) #\Y + (cell-style source) '(:italic)) + (screen-cells-is screen + (2 1 #\Z :style '(:bold)))) + + (let* ((style (list :bold)) + (cell (make-cell :char #\N :style style))) + (screen-put-cell screen 0 0 cell :style '(:italic)) + (setf (car style) :reverse) + (screen-cells-is screen + (0 0 #\N :style '(:italic)))) + + (let* ((style (list :bold)) + (cell (make-cell :char #\P :style '(:underline)))) + (screen-put-cell screen 1 0 cell :style style) + (setf (car style) :italic) + (screen-cells-is screen + (1 0 #\P :style '(:bold)))) + + (bounds-error-is (condition 3 0 3 2) + (screen-cell screen 3 0)) + + ;; A negative X or Y is out of bounds too, not just an overflow. + (bounds-error-is (condition -1 0 3 2) + (screen-cell screen -1 0)) + (bounds-error-is (condition 0 -1 3 2) + (screen-cell screen 0 -1)) + + (dimensions-error-is (condition -1 2) + (screen-resize screen -1 2)) + (dimensions-error-is (condition -1 2) + (screen-fill-rect screen 0 0 -1 2 #\X)))) + +(defun %test-screen-initial-cell-cow () + (let ((filled (make-screen 2 1 :initial-cell #\X))) + (screen-cells-is filled + (0 0 #\X) + (1 0 #\X))) + + (let ((source (make-cell :char #\J :style '(:bold)))) + (let ((filled (make-screen 1 1 :initial-cell source))) + (setf (cell-char source) #\K + (cell-style source) '(:italic)) + (cell-is (filled 0 0) #\J '(:bold)))) + + (let* ((source (make-cell :char #\N :style '(:underline))) + (filled (make-screen 2 1 :initial-cell source))) + (is (not (eq (aref (screen-cells filled) 0) + (aref (screen-cells filled) 1)))) + (setf (cell-char (aref (screen-cells filled) 0)) #\O) + (cell-is (filled 1 0) #\N '(:underline))) + + (let ((source (make-cell :char #\L :style '(:bold))) + (filled (make-screen 2 1 :initial-cell #\Space))) + (screen-clear filled :cell source) + (is (= 2 (length (screen-cells filled)))) + (is (not (eq (aref (screen-cells filled) 0) + (aref (screen-cells filled) 1)))) + (setf (cell-char source) #\M + (cell-style source) '(:italic)) + (screen-cells-is filled + (0 0 #\L :style '(:bold)) + (1 0 #\L :style '(:bold))))) + +(defun %test-screen-write-string-edge-cases () + (let ((partial (make-screen 6 1 :initial-cell #\.))) + (screen-write-string partial 1 0 "prefix" :start 2 :end 5) + (screen-cells-is partial + (0 0 #\.) + (1 0 #\e) + (2 0 #\f) + (3 0 #\i) + (4 0 #\.) + (5 0 #\.))) + + (let ((unchanged (make-screen 3 1 :initial-cell #\.))) + (screen-write-string unchanged 1 0 "prefix" :start 3 :end 3) + (screen-cells-is unchanged + (0 0 #\.) + (1 0 #\.) + (2 0 #\.))) + + (let ((unchanged (make-screen 3 1 :initial-cell #\.))) + (signals (error condition) + (screen-write-string unchanged 0 0 "prefix" :start 4 :end 2) + (declare (ignore condition))) + (signals (error condition) + (screen-write-string unchanged 0 0 "prefix" :start -1) + (declare (ignore condition))) + (signals (error condition) + (screen-write-string unchanged 0 0 "prefix" :end 7) + (declare (ignore condition))) + (screen-cells-is unchanged + (0 0 #\.) + (1 0 #\.) + (2 0 #\.)))) + +(defun %test-screen-write-string-style-cow () + (let* ((style (list :bold '(:fg 33))) + (styled (make-screen 2 1))) + (screen-write-string styled 0 0 "OK" :style style) + (setf (first style) :italic + (second style) '(:fg 44)) + (screen-cells-is styled + (0 0 #\O :style '(:bold (:fg 33))) + (1 0 #\K :style '(:bold (:fg 33)))))) + +(defun %test-screen-wide-glyph-placement () + (let ((ideograph (code-char #x65E5))) + (let ((wide (make-screen 3 1 :initial-cell #\.))) + (screen-write-string wide 0 0 (coerce (list ideograph #\X) 'string)) + (screen-cells-is wide + (0 0 ideograph) + (1 0 #\Space) + (2 0 #\X))) + + (let ((wide (make-screen 4 1 :initial-cell #\.))) + (screen-write-string wide 0 0 (coerce (list #\X ideograph #\Y) 'string)) + (screen-cells-is wide + (0 0 #\X) + (1 0 ideograph) + (2 0 #\Space) + (3 0 #\Y))) + + (let ((wide (make-screen 2 1))) + (screen-write-string wide 0 0 (string ideograph) :style '(:bold)) + (screen-cells-is wide + (0 0 ideograph :style '(:bold)) + (1 0 #\Space :style '(:bold)))) + + (bounds-error-is (condition 1 0 1 1) + (screen-write-string (make-screen 1 1) 0 0 (string ideograph))))) + +(defun %test-cell-copy-on-write () + (let ((cell (make-cell :char #\Q :style '(:bold))) + (copy nil)) + (setf copy (copy-cell cell) + (cell-char cell) #\R + (cell-style cell) '(:italic)) + (is (char= #\Q (cell-char copy))) + (is-equal '(:bold) (cell-style copy))) + + (let* ((style (list :bold)) + (cell (make-cell :char #\S :style style)) + (copy (copy-cell cell))) + (setf (car style) :italic) + (is-equal '(:bold) (cell-style cell)) + (is-equal '(:bold) (cell-style copy))) + + (let* ((style (list :underline)) + (cell (make-cell :char #\M :style style))) + (setf (car style) :reverse) + (is-equal '(:underline) (cell-style cell))) + + (let* ((style (list :bold '(:fg 33) '(:bg 99))) + (cell (make-cell :char #\K :style style)) + (copy (copy-cell cell))) + (setf (second style) '(:fg 44) + (third style) '(:bg 88)) + (is-equal '(:bold (:fg 33) (:bg 99)) + (cell-style cell)) + (is-equal '(:bold (:fg 33) (:bg 99)) + (cell-style copy)))) + +(defun %test-render-diff-style-order-independence () + (let ((cells-a (make-screen 1 1)) + (cells-b (make-screen 1 1))) + (screen-put-cell cells-a 0 0 #\X :style '(:bold :underline)) + (screen-put-cell cells-b 0 0 #\X :style '(:underline :bold)) + (is (string= "" (render-diff cells-a cells-b)))) + + (let ((cells-a (make-screen 1 1)) + (cells-b (make-screen 1 1))) + (screen-put-cell cells-a 0 0 #\X :style '(:bold (:fg 196) (:bg 17))) + (screen-put-cell cells-b 0 0 #\X :style '((:bg 17) (:fg 196) :bold)) + (is (string= "" (render-diff cells-a cells-b))))) + +(defun %test-cell-style-normalization () + (let ((cell (make-cell :char #\C :style '(:bold (:fg 196) (:bg 17))))) + (is-equal '(:bold (:fg 196) (:bg 17)) + (cell-style cell))) + + (let ((cell (make-cell :char #\C + :style '((:fg 12) (:fg 196) (:bg 1) (:bg 17))))) + (is-equal '((:fg 196) (:bg 17)) + (cell-style cell))) + + (let ((cell (make-cell :char #\C + :style '(:underline (:fg 1 2 3) (:bg 4 5 6))))) + (is-equal '(:underline (:fg 1 2 3) (:bg 4 5 6)) + (cell-style cell))) + + (let ((cell (make-cell :char #\C + :style '(:bold (:fg 256) (:bg 1 2) (:fg 7))))) + (is-equal '(:bold (:fg 7)) + (cell-style cell))) + + (let ((cell (make-cell :char #\C + :style '((:fg . 1) :bold)))) + (is-equal '(:bold) + (cell-style cell))) + + (is (null (make-style '(:fg . 1)))) + + (let ((cell (make-cell))) + (is (char= #\Space (cell-char cell))) + (is (null (cell-style cell)))) + + (signals (error condition) (make-cell :char "C") + (declare (ignore condition))) + (signals (error condition) (copy-cell :not-a-cell) + (declare (ignore condition))) + + (let ((cell (make-cell :char #\C + :style '(:fg 33)))) + (is-equal '((:fg 33)) + (cell-style cell))) + + (let ((cell (make-cell :char #\C :style nil))) + (is (null (cell-style cell)))) + + (is-equal '(:bold (:fg 196) (:bg 1 2 3)) + (make-style :bold + (style-fg 12) + (style-fg 196) + (style-bg 1 2 3))) + + (let ((cell (make-cell :char #\C + :style (make-style :underline + (style-fg 4 5 6) + (style-bg 17))))) + (is-equal '(:underline (:fg 4 5 6) (:bg 17)) + (cell-style cell))) + + (signals (error condition) (style-fg 256) + (declare (ignore condition))) + (signals (error condition) (style-fg 1 2 999) + (declare (ignore condition))) + (signals (error condition) (style-bg 1 2) + (declare (ignore condition)))) + +(defun %test-screen-bounds-and-dimension-errors () + (let ((zero-area (make-screen 2 2 :initial-cell #\.))) + (screen-fill-rect zero-area 5 5 0 2 #\X) + (screen-fill-rect zero-area -3 -4 2 0 #\Y) + (screen-cells-is zero-area + (0 0 #\.) + (1 1 #\.))) + + (let ((overflow (make-screen 3 1 :initial-cell #\.))) + (bounds-error-is (condition 4 0 3 1) + (screen-write-string overflow 1 0 "abcd")) + (screen-cells-is overflow + (0 0 #\.) + (1 0 #\.) + (2 0 #\.))) + + (let ((overflow (make-screen 3 2 :initial-cell #\.))) + (bounds-error-is (condition 3 1 3 2) + (screen-fill-rect overflow 1 0 3 2 #\#)) + (screen-cells-is overflow + (0 0 #\.) + (1 0 #\.) + (2 1 #\.))) + + (dimensions-error-is (condition -1 2) + (make-screen -1 2)) + (dimensions-error-is (condition 2 -1) + (make-screen 2 -1)) + ;; A dimension too large to ever allocate signals the documented condition + ;; rather than a raw type-error/make-array failure: a non-fixnum bignum side + ;; and a fixnum side whose product exceeds ARRAY-TOTAL-SIZE-LIMIT. + (dimensions-error-is (condition #.(expt 10 30) 1) + (make-screen #.(expt 10 30) 1)) + (dimensions-error-is (condition #.array-total-size-limit 2) + (make-screen #.array-total-size-limit 2))) + +(defun test-screen () + (%test-screen-public-validation) + (%test-screen-fill) + (%test-screen-copy) + (%test-screen-row-string) + (%test-screen-scroll) + (%test-screen-blit) + (%test-screen-write-lines) + (%test-screen-write-wrapped) + (%test-screen-to-string) + (%test-screen-write-aligned) + (%test-screen-crop) + (%test-screen-mutation-sequence) + (%test-screen-initial-cell-cow) + (%test-screen-write-string-edge-cases) + (%test-screen-write-string-style-cow) + (%test-screen-wide-glyph-placement) + (%test-cell-copy-on-write) + (%test-render-diff-style-order-independence) + (%test-cell-style-normalization) + (%test-screen-bounds-and-dimension-errors)) diff --git a/t/screen.lisp b/t/screen.lisp index 81a8fcb..cddb2ad 100644 --- a/t/screen.lisp +++ b/t/screen.lisp @@ -299,412 +299,3 @@ (let ((crop (screen-crop (%screen-rows "AB") (make-rect :x 9 :y 9 :width 2 :height 2)))) (is (= 0 (screen-width crop))) (is (= 0 (screen-height crop))))) - -(defun %test-screen-mutation-sequence () - (let ((screen (make-screen 3 2))) - (is (= 3 (screen-width screen))) - (is (= 2 (screen-height screen))) - (screen-cells-is screen - (0 0 #\Space)) - - (screen-put-cell screen 1 0 #\X) - (screen-cells-is screen - (1 0 #\X)) - - (let ((resized (screen-resize screen 4 3 :initial-cell #\.))) - (is (eq screen resized)) - (is (= 4 (screen-width screen))) - (is (= 3 (screen-height screen))) - (screen-cells-is screen - (0 0 #\Space) - (1 0 #\X) - (3 2 #\.))) - - (screen-put-cell screen 3 2 #\Z :style '(:bold)) - (screen-resize screen 2 1) - (is (= 2 (screen-width screen))) - (is (= 1 (screen-height screen))) - (screen-cells-is screen - (0 0 #\Space) - (1 0 #\X)) - - (let ((template (make-cell :char #\R :style '(:underline)))) - (screen-resize screen 3 2 :initial-cell template) - (setf (cell-char template) #\S - (cell-style template) '(:italic)) - (screen-cells-is screen - (2 1 #\R :style '(:underline)))) - - (screen-clear screen) - (screen-cells-is screen - (1 0 #\Space)) - (screen-clear screen :cell #\.) - (screen-cells-is screen - (0 0 #\.) - (2 1 #\.)) - (screen-clear screen :cell nil) - (screen-cells-is screen - (0 0 #\Space) - (2 1 #\Space)) - - (let ((source (make-cell :char #\A :style '(:bold)))) - (screen-put-cell screen 0 1 source) - (setf (cell-char source) #\B - (cell-style source) '(:italic)) - (screen-cells-is screen - (0 1 #\A :style '(:bold)))) - - (setf (screen-cell screen 2 1) #\T) - (screen-cells-is screen - (2 1 #\T)) - - (let ((source (make-cell :char #\C :style '(:bold)))) - (screen-put-cell screen 1 1 source :style '(:italic)) - (screen-cells-is screen - (1 1 #\C :style '(:italic)))) - - (let ((source (make-cell :char #\D :style '(:bold)))) - (screen-put-cell screen 2 0 source :style nil) - (screen-cells-is screen - (2 0 #\D))) - - (let ((written (screen-write-string screen 0 0 "abc"))) - (is (eq screen written)) - (screen-cells-is screen - (0 0 #\a) - (1 0 #\b) - (2 0 #\c))) - - (screen-write-string screen 0 1 "xy" :style '(:underline)) - (screen-cells-is screen - (0 1 #\x :style '(:underline)) - (1 1 #\y :style '(:underline))) - - (let ((filled (screen-fill-rect screen 0 0 2 2 #\*))) - (is (eq screen filled)) - (screen-cells-is screen - (0 0 #\*) - (1 0 #\*) - (0 1 #\*) - (1 1 #\*))) - - (let ((source (make-cell :char #\Q :style '(:bold)))) - (screen-fill-rect screen 1 0 2 1 source) - (setf (cell-char source) #\R - (cell-style source) '(:italic)) - (screen-cells-is screen - (1 0 #\Q :style '(:bold)) - (2 0 #\Q :style '(:bold)))) - - (let ((source (make-cell :char #\S :style '(:bold)))) - (screen-fill-rect screen 0 1 2 1 source :style '(:italic)) - (screen-cells-is screen - (0 1 #\S :style '(:italic)) - (1 1 #\S :style '(:italic)))) - - (screen-write-string screen 0 0 "prefix" :start 2 :end 5) - (screen-cells-is screen - (0 0 #\e) - (1 0 #\f) - (2 0 #\i)) - - (let ((source (make-cell :char #\Z :style '(:bold)))) - (screen-clear screen :cell source) - (setf (cell-char source) #\Y - (cell-style source) '(:italic)) - (screen-cells-is screen - (2 1 #\Z :style '(:bold)))) - - (let* ((style (list :bold)) - (cell (make-cell :char #\N :style style))) - (screen-put-cell screen 0 0 cell :style '(:italic)) - (setf (car style) :reverse) - (screen-cells-is screen - (0 0 #\N :style '(:italic)))) - - (let* ((style (list :bold)) - (cell (make-cell :char #\P :style '(:underline)))) - (screen-put-cell screen 1 0 cell :style style) - (setf (car style) :italic) - (screen-cells-is screen - (1 0 #\P :style '(:bold)))) - - (bounds-error-is (condition 3 0 3 2) - (screen-cell screen 3 0)) - - ;; A negative X or Y is out of bounds too, not just an overflow. - (bounds-error-is (condition -1 0 3 2) - (screen-cell screen -1 0)) - (bounds-error-is (condition 0 -1 3 2) - (screen-cell screen 0 -1)) - - (dimensions-error-is (condition -1 2) - (screen-resize screen -1 2)) - (dimensions-error-is (condition -1 2) - (screen-fill-rect screen 0 0 -1 2 #\X)))) - -(defun %test-screen-initial-cell-cow () - (let ((filled (make-screen 2 1 :initial-cell #\X))) - (screen-cells-is filled - (0 0 #\X) - (1 0 #\X))) - - (let ((source (make-cell :char #\J :style '(:bold)))) - (let ((filled (make-screen 1 1 :initial-cell source))) - (setf (cell-char source) #\K - (cell-style source) '(:italic)) - (cell-is (filled 0 0) #\J '(:bold)))) - - (let* ((source (make-cell :char #\N :style '(:underline))) - (filled (make-screen 2 1 :initial-cell source))) - (is (not (eq (aref (screen-cells filled) 0) - (aref (screen-cells filled) 1)))) - (setf (cell-char (aref (screen-cells filled) 0)) #\O) - (cell-is (filled 1 0) #\N '(:underline))) - - (let ((source (make-cell :char #\L :style '(:bold))) - (filled (make-screen 2 1 :initial-cell #\Space))) - (screen-clear filled :cell source) - (is (= 2 (length (screen-cells filled)))) - (is (not (eq (aref (screen-cells filled) 0) - (aref (screen-cells filled) 1)))) - (setf (cell-char source) #\M - (cell-style source) '(:italic)) - (screen-cells-is filled - (0 0 #\L :style '(:bold)) - (1 0 #\L :style '(:bold))))) - -(defun %test-screen-write-string-edge-cases () - (let ((partial (make-screen 6 1 :initial-cell #\.))) - (screen-write-string partial 1 0 "prefix" :start 2 :end 5) - (screen-cells-is partial - (0 0 #\.) - (1 0 #\e) - (2 0 #\f) - (3 0 #\i) - (4 0 #\.) - (5 0 #\.))) - - (let ((unchanged (make-screen 3 1 :initial-cell #\.))) - (screen-write-string unchanged 1 0 "prefix" :start 3 :end 3) - (screen-cells-is unchanged - (0 0 #\.) - (1 0 #\.) - (2 0 #\.))) - - (let ((unchanged (make-screen 3 1 :initial-cell #\.))) - (signals (error condition) - (screen-write-string unchanged 0 0 "prefix" :start 4 :end 2) - (declare (ignore condition))) - (signals (error condition) - (screen-write-string unchanged 0 0 "prefix" :start -1) - (declare (ignore condition))) - (signals (error condition) - (screen-write-string unchanged 0 0 "prefix" :end 7) - (declare (ignore condition))) - (screen-cells-is unchanged - (0 0 #\.) - (1 0 #\.) - (2 0 #\.)))) - -(defun %test-screen-write-string-style-cow () - (let* ((style (list :bold '(:fg 33))) - (styled (make-screen 2 1))) - (screen-write-string styled 0 0 "OK" :style style) - (setf (first style) :italic - (second style) '(:fg 44)) - (screen-cells-is styled - (0 0 #\O :style '(:bold (:fg 33))) - (1 0 #\K :style '(:bold (:fg 33)))))) - -(defun %test-screen-wide-glyph-placement () - (let ((ideograph (code-char #x65E5))) - (let ((wide (make-screen 3 1 :initial-cell #\.))) - (screen-write-string wide 0 0 (coerce (list ideograph #\X) 'string)) - (screen-cells-is wide - (0 0 ideograph) - (1 0 #\Space) - (2 0 #\X))) - - (let ((wide (make-screen 4 1 :initial-cell #\.))) - (screen-write-string wide 0 0 (coerce (list #\X ideograph #\Y) 'string)) - (screen-cells-is wide - (0 0 #\X) - (1 0 ideograph) - (2 0 #\Space) - (3 0 #\Y))) - - (let ((wide (make-screen 2 1))) - (screen-write-string wide 0 0 (string ideograph) :style '(:bold)) - (screen-cells-is wide - (0 0 ideograph :style '(:bold)) - (1 0 #\Space :style '(:bold)))) - - (bounds-error-is (condition 1 0 1 1) - (screen-write-string (make-screen 1 1) 0 0 (string ideograph))))) - -(defun %test-cell-copy-on-write () - (let ((cell (make-cell :char #\Q :style '(:bold))) - (copy nil)) - (setf copy (copy-cell cell) - (cell-char cell) #\R - (cell-style cell) '(:italic)) - (is (char= #\Q (cell-char copy))) - (is-equal '(:bold) (cell-style copy))) - - (let* ((style (list :bold)) - (cell (make-cell :char #\S :style style)) - (copy (copy-cell cell))) - (setf (car style) :italic) - (is-equal '(:bold) (cell-style cell)) - (is-equal '(:bold) (cell-style copy))) - - (let* ((style (list :underline)) - (cell (make-cell :char #\M :style style))) - (setf (car style) :reverse) - (is-equal '(:underline) (cell-style cell))) - - (let* ((style (list :bold '(:fg 33) '(:bg 99))) - (cell (make-cell :char #\K :style style)) - (copy (copy-cell cell))) - (setf (second style) '(:fg 44) - (third style) '(:bg 88)) - (is-equal '(:bold (:fg 33) (:bg 99)) - (cell-style cell)) - (is-equal '(:bold (:fg 33) (:bg 99)) - (cell-style copy)))) - -(defun %test-render-diff-style-order-independence () - (let ((cells-a (make-screen 1 1)) - (cells-b (make-screen 1 1))) - (screen-put-cell cells-a 0 0 #\X :style '(:bold :underline)) - (screen-put-cell cells-b 0 0 #\X :style '(:underline :bold)) - (is (string= "" (render-diff cells-a cells-b)))) - - (let ((cells-a (make-screen 1 1)) - (cells-b (make-screen 1 1))) - (screen-put-cell cells-a 0 0 #\X :style '(:bold (:fg 196) (:bg 17))) - (screen-put-cell cells-b 0 0 #\X :style '((:bg 17) (:fg 196) :bold)) - (is (string= "" (render-diff cells-a cells-b))))) - -(defun %test-cell-style-normalization () - (let ((cell (make-cell :char #\C :style '(:bold (:fg 196) (:bg 17))))) - (is-equal '(:bold (:fg 196) (:bg 17)) - (cell-style cell))) - - (let ((cell (make-cell :char #\C - :style '((:fg 12) (:fg 196) (:bg 1) (:bg 17))))) - (is-equal '((:fg 196) (:bg 17)) - (cell-style cell))) - - (let ((cell (make-cell :char #\C - :style '(:underline (:fg 1 2 3) (:bg 4 5 6))))) - (is-equal '(:underline (:fg 1 2 3) (:bg 4 5 6)) - (cell-style cell))) - - (let ((cell (make-cell :char #\C - :style '(:bold (:fg 256) (:bg 1 2) (:fg 7))))) - (is-equal '(:bold (:fg 7)) - (cell-style cell))) - - (let ((cell (make-cell :char #\C - :style '((:fg . 1) :bold)))) - (is-equal '(:bold) - (cell-style cell))) - - (is (null (make-style '(:fg . 1)))) - - (let ((cell (make-cell))) - (is (char= #\Space (cell-char cell))) - (is (null (cell-style cell)))) - - (signals (error condition) (make-cell :char "C") - (declare (ignore condition))) - (signals (error condition) (copy-cell :not-a-cell) - (declare (ignore condition))) - - (let ((cell (make-cell :char #\C - :style '(:fg 33)))) - (is-equal '((:fg 33)) - (cell-style cell))) - - (let ((cell (make-cell :char #\C :style nil))) - (is (null (cell-style cell)))) - - (is-equal '(:bold (:fg 196) (:bg 1 2 3)) - (make-style :bold - (style-fg 12) - (style-fg 196) - (style-bg 1 2 3))) - - (let ((cell (make-cell :char #\C - :style (make-style :underline - (style-fg 4 5 6) - (style-bg 17))))) - (is-equal '(:underline (:fg 4 5 6) (:bg 17)) - (cell-style cell))) - - (signals (error condition) (style-fg 256) - (declare (ignore condition))) - (signals (error condition) (style-fg 1 2 999) - (declare (ignore condition))) - (signals (error condition) (style-bg 1 2) - (declare (ignore condition)))) - -(defun %test-screen-bounds-and-dimension-errors () - (let ((zero-area (make-screen 2 2 :initial-cell #\.))) - (screen-fill-rect zero-area 5 5 0 2 #\X) - (screen-fill-rect zero-area -3 -4 2 0 #\Y) - (screen-cells-is zero-area - (0 0 #\.) - (1 1 #\.))) - - (let ((overflow (make-screen 3 1 :initial-cell #\.))) - (bounds-error-is (condition 4 0 3 1) - (screen-write-string overflow 1 0 "abcd")) - (screen-cells-is overflow - (0 0 #\.) - (1 0 #\.) - (2 0 #\.))) - - (let ((overflow (make-screen 3 2 :initial-cell #\.))) - (bounds-error-is (condition 3 1 3 2) - (screen-fill-rect overflow 1 0 3 2 #\#)) - (screen-cells-is overflow - (0 0 #\.) - (1 0 #\.) - (2 1 #\.))) - - (dimensions-error-is (condition -1 2) - (make-screen -1 2)) - (dimensions-error-is (condition 2 -1) - (make-screen 2 -1)) - ;; A dimension too large to ever allocate signals the documented condition - ;; rather than a raw type-error/make-array failure: a non-fixnum bignum side - ;; and a fixnum side whose product exceeds ARRAY-TOTAL-SIZE-LIMIT. - (dimensions-error-is (condition #.(expt 10 30) 1) - (make-screen #.(expt 10 30) 1)) - (dimensions-error-is (condition #.array-total-size-limit 2) - (make-screen #.array-total-size-limit 2))) - -(defun test-screen () - (%test-screen-public-validation) - (%test-screen-fill) - (%test-screen-copy) - (%test-screen-row-string) - (%test-screen-scroll) - (%test-screen-blit) - (%test-screen-write-lines) - (%test-screen-write-wrapped) - (%test-screen-to-string) - (%test-screen-write-aligned) - (%test-screen-crop) - (%test-screen-mutation-sequence) - (%test-screen-initial-cell-cow) - (%test-screen-write-string-edge-cases) - (%test-screen-write-string-style-cow) - (%test-screen-wide-glyph-placement) - (%test-cell-copy-on-write) - (%test-render-diff-style-order-independence) - (%test-cell-style-normalization) - (%test-screen-bounds-and-dimension-errors)) diff --git a/vendor/cl-prolog b/vendor/cl-prolog deleted file mode 160000 index b3275ad..0000000 --- a/vendor/cl-prolog +++ /dev/null @@ -1 +0,0 @@ -Subproject commit b3275ad2697ebcdcd97f1f9f586426d750d3ddb7 diff --git a/vendor/cl-weave b/vendor/cl-weave deleted file mode 160000 index fc41b53..0000000 --- a/vendor/cl-weave +++ /dev/null @@ -1 +0,0 @@ -Subproject commit fc41b5319501ab5230ad1c0aeda49f493f5cf42a