9 Commits

Author SHA1 Message Date
60ce9c894c fix: backend-clear called with framebuffer instead of backend
Main loop was calling (backend-clear curr-fb) where curr-fb is a
framebuffer array. Changed to (backend-clear be) using the cl-tty
backend, which writes the terminal clear escape sequence.
2026-05-13 16:29:50 -04:00
36e7d51fce fix: add missing keyword clause in printable branch of on-key
The revert removed the (keyword ...) clause from the typecase in
on-key's printable branch. Keyword symbols from the main loop
(:a, :h, etc.) fell through to (t nil), making all character input
silently ignored. Typing and sending now works correctly.
2026-05-13 16:25:37 -04:00
af4d81ec9f fix: add word-wrap function, complete TUI migration
- Add missing word-wrap function (was declared in contract but never defined)
- TUI now renders correctly: draw-text on framebuffer arrays works
- Daemon connection verified
- All three view functions (status, chat, input) call draw-text correctly
2026-05-13 16:06:05 -04:00
79896c5ffd fix: bypass ASDF compile for TUI load, use direct compile-file+load 2026-05-13 14:53:27 -04:00
4b60e8c544 fix: stty graceful failure, backend-size TYPE-ERROR safety net
- cl-tty stty calls now use :ignore-error-status t (works in PTY/piped env)
- backend-size wraps in ignore-errors with 80x24 fallback in resize handler
- Both fixes enable TUI to run in environments without full terminal capabilities
2026-05-13 14:21:57 -04:00
885fc3f92e fix: resolve TUI compilation errors, replace ST calls with GETF
- Remove dead croatoan-to-tty-event keymap dispatch clause from on-key
- Replace all (st :key) with (getf *state* :key) and all
  (setf (st :key) val) with (setf (getf *state* :key) val)
  to avoid SBCL cross-file SETF expander issues (239 replacements)
- Fix redraw arity: called with 4 args but defined with 3
- TUI now loads, initializes, and connects to daemon successfully
2026-05-13 14:04:25 -04:00
6e69c4a724 v0.8.0: complete cl-tty TUI migration — remove all Croatoan deps
- Replace numeric key code dispatch with cl-tty keyword events
- Replace Croatoan code-key/key-name normalization with direct keyword dispatch
- Update main loop to construct Ctrl-key keywords from cl-tty key-event modifiers
- Remove croatoan-to-tty-event compatibility shim and its test
- Remove duplicate Esc handling from main loop (now handled by on-key)
- Update all documentation contracts, prose, docstrings to remove Croatoan refs
- Remove :croatoan from package dependencies
- All event handling now goes through cl-tty keymaps or keyword dispatch
2026-05-13 12:46:43 -04:00
761678bbd6 docs: trim roadmap to v1.0.0, move v2.0.0+ to stoa
Cut v2.0.0 (Lisp Machine Emergence), v3.0.0+ (Cannibalization), v4.0.0+
(Native Inference, Hardware, True Agency) from passepartout roadmap.
These belong to Stoa — the body/environment layer. Passepartout now
only tracks the path to Neurosymbolic Maturity (v1.0.0).
2026-05-13 11:48:08 -04:00
2d18fa4525 docs: port TUI roadmap to cl-tty, mark Emacs as secondary client
v0.8.0: Information Radiator now built on cl-tty v1.1.0. Minibuffer
uses cl-tty Dialog stack. New TODO items: conversation view (ScrollBox
+ Markdown), command palette (Select), sidebar (slot system), status bar
(Box + Theme), keybindings (keymap).

v0.9.1: Emacs is now an optional secondary client, not the primary
bridge. cl-tty is the primary TUI.
2026-05-13 11:41:41 -04:00
10 changed files with 953 additions and 3133 deletions

1
docs/.#ROADMAP.org Symbolic link
View File

@@ -0,0 +1 @@
user@amr.1407003:1778162380

View File

@@ -36,31 +36,89 @@ On release:
** TODO v0.8.0: Information Radiator (Foundation)
Sidebar (6 panels), sidebar overlay mode (<120 cols), command palette (Ctrl+P), TrueColor theme expansion (8 presets), unified minibuffer panel with slash-command context menu and sub-mode navigation (wizard, settings, help).
Sidebar (6 panels), sidebar overlay mode (<120 cols), command palette (Ctrl+P), TrueColor theme (8 presets), unified minibuffer panel with slash-command context menu and sub-mode navigation (wizard, settings, help) — all built on ~cl-tty~ v1.1.0.
*** DONE Unified minibuffer slash-command panel
The croatoan TUI is replaced entirely. cl-tty provides the widget set (box, text, scrollbox, select, markdown, dialog), keybinding system, and theme engine. Passepartout's job is wiring — cl-tty components call the daemon's TCP API and render its response structures.
*** TODO Minibuffer — cl-tty dialog stack
:PROPERTIES:
:ID: id-v080-minibuffer
:CREATED: [2026-05-10 Sat]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-10 Sat]
Replace ad-hoc overlay windows with cl-tty's ~Dialog~ stack. Typing =/= auto-opens a ~select-dialog~ with ~25 slash commands (filtered in real time). Selecting =/wizard= transitions to a ~prompt-dialog~ in the same panel — cl-tty's ~*dialog-stack*~ handles push/pop, Esc dismisses. Future sub-modes (=/settings=, =/help=) slot in as additional dialog types.
- Define ~*slash-commands*~ — the same data structure, now driving cl-tty's ~Select~ options
- Wire ~select-dialog~ on-Enter to push the next dialog type (wizard, settings, help)
- Implement ~wizard-dialog~ subclass — validates UUID, writes ~/.passepartout/config.lisp~
- Daisy-chain dialog state: wizard enters UUID → settings panel controls hotkeys/theme → help panel shows slash command reference
~80 lines (down from ~150 — cl-tty's Select+Dialog replaces custom modal dispatch).
*** TODO Conversation view — cl-tty ScrollBox + Markdown
:PROPERTIES:
:ID: id-v080-conversation
:CREATED: [2026-05-13 Wed]
:END:
Replace ad-hoc overlay windows with a single bottom-anchored panel. Typing =/= as the first character opens a command context menu (~25 slash commands, filtered in real time as the user types). Navigating to =/wizard= and pressing Enter transitions the panel into the setup wizard — same panel, same position, sub-mode stack. Esc returns to the command list. Future sub-modes (=/settings=, =/help=) slot into the same architecture.
- Add ~:minibuffer-mode~ and ~:minibuffer-selected-idx~ state fields to ~init-state~
- Extract ~*slash-commands*~ data structure (~25 commands, each with description) from the ~on-key~ Enter handler
- Add ~view-minibuffer~ that dispatches on ~:minibuffer-mode~ to ~view-slash-menu~, ~view-wizard-in-panel~
- Add ~minibuffer-handle-key~ which dispatches to ~slash-menu-handle-key~ or ~wizard-handle-key~
- TUI event loop: replace separate wizard key handlers with unified modal dispatch block
- ~on-key~: auto-open slash-menu when =/= typed as first character
- ~wizard-start~ / ~wizard-cancel~: set ~:minibuffer-mode~ instead of ~:wizard-visible~
- Merge the wizard overlay (centered, 60x14) into the bottom-anchored panel
- Remove ~:wizard-visible~ state field
- ~ScrollBox~ with ~sticky-scroll~ (auto-follows new content, respects manual scroll-up)
- User messages rendered as ~Box~ (role-colored left border)
- Agent messages rendered via cl-tty's ~Markdown~ + ~Code~ + ~Diff~ renderables
- Tool calls rendered as ~Select~ (collapsible, status-indicated: spinner running / green done / red error)
- Gate trace as a collapsible ~Box~ within agent messages (property-drawer style)
~150 lines.
*** TODO Command palette — cl-tty Select
:PROPERTIES:
:ID: id-v080-palette
:CREATED: [2026-05-13 Wed]
:END:
- Ctrl+P opens a ~select-dialog~ with all daemon commands
- Fuzzy-filtered with categories (session, memory, system, help)
- Enter dispatches the command to the daemon via TCP, displays result in conversation
~40 lines.
*** TODO Sidebar — cl-tty slot system
:PROPERTIES:
:ID: id-v080-sidebar
:CREATED: [2026-05-13 Wed]
:END:
- 6 panels as cl-tty ~slot~ registrations (gate trace, focus, rules, context, cost, files)
- Toggle with Ctrl+B or auto-hide on narrow terminals (<120 cols)
- Panel data sourced from daemon's existing response plist keys (~:rule-count~, ~:focal-id~, ~:gate-trace~, etc.)
~80 lines.
*** TODO Status bar — cl-tty Box + Theme
:PROPERTIES:
:ID: id-v080-statusbar
:CREATED: [2026-05-13 Wed]
:END:
- Bottom-most line: directory, LSP status (green dot), MCP count, ~/status~ hint
- Degraded-mode signaling (amber when ~*degraded-components*~ non-nil)
- cl-tty theme tokens for colors — works with all 8 presets
~30 lines.
*** TODO Keybinding layer — cl-tty keymap
:PROPERTIES:
:ID: id-v080-keybindings
:CREATED: [2026-05-13 Wed]
:END:
- Global: Ctrl+P (palette), Ctrl+B (sidebar), Ctrl+Q (quit), PageUp/PageDn (scroll)
- Prompt: Enter (send), Ctrl+C (interrupt), Up/Dn (history)
- cl-tty's layered keymaps handle priority (global → local → input)
~40 lines.
~420 lines total.
** v0.9.0: Eval Harness — Safety Net First
Every subsequent release ships with automated regression protection. The eval harness is the gate that makes self-modification safe — before any neurosymbolic component modifies the system, the harness verifies nothing broke.
@@ -79,9 +137,9 @@ Every subsequent release ships with automated regression protection. The eval ha
- Task suite grows with codebase: every bug fix adds a regression task
~200 lines.
** v0.9.1: Emacs Development Environment — A Functional UI
** v0.9.1: Emacs Development Environment — Secondary Client
The croatoan TUI is on life support — enough to see output and type commands, but every render feature (markdown, tool visualization, mouse, adaptive layout) requires custom ncurses code destined for the trash at v2.0.0. Emacs is the v2.0.0 bridge: the same major mode, sidebar, and M-x commands survive from now through Phase III.
cl-tty is the primary TUI (v0.8.0). The Emacs major mode is an optional secondary client for users who prefer Emacs-based workflows. Both clients communicate with the same daemon over the same TCP protocol — they are interchangeable frontends, not competing architectures.
*** TODO Emacs major mode
:PROPERTIES:
@@ -1533,247 +1591,3 @@ The system is benchmarked against SWE-bench (competitive score with Claude Code
The TUI at v1.0.0 is competitive: streaming responses, gate trace visualization, sidebar with 10 panels, skin system with 10+ presets, adaptive layout, full markdown, mouse support, spinner personality, and progress bars. The sidebar's gate trace, focus map, rule counter, sufficiency score, and provenance breakdown are capabilities no competitor can replicate — Passepartout's permanent UX differentiator.
v1.0.0 is the brain at maturity. The symbolic engine reasons. The probabilistic engine translates. The gate stack verifies. The Merkle tree preserves provenance. The eval harness guards against regression.
* v2.0.0: Lisp Machine Emergence
v2.0.0 is where Passepartout stops being a daemon with clients and becomes the environment. The agent's cognitive loop, the user's editor, the user's shell, and the user's browser run in the same Common Lisp image. The Dispatcher gate stack verifies every action regardless of who initiated it — user or agent. The distinction between "tool" and "self" dissolves.
*Why this version matters for UX parity.* v0.4.0 through v1.0.0 give Passepartout four interaction surfaces (TUI, messaging apps, Emacs, voice). v2.0.0 inverts the problem: instead of building more clients, it builds a platform where the agent's environment and the user's environment are the same process, separated not by a sandbox but by the Dispatcher gate stack. The editor IS the agent's prompt. The shell IS the agent's actuator. The browser IS the agent's web research tool. There are no clients — there is one Lisp image, one address space, one Org-mode file system.
*Architectural principle: Browser inside Lisp, not Lisp inside browser.* Lisp is the parent process. It owns the window, the memory, and the input loop. The rendering engine (WebKit/Blink) is a library that paints pixels inside a Lisp buffer. The user can redefine functions while browsing without restarting. Keybinding lookups happen in microseconds (SBCL machine code) — the browser cannot "steal" shortcuts.
** Qt/QML via EQL5 — the rendering surface
- Qt/QML (via EQL5) is the UI framework. EQL5 exposes the full Qt C++ API from Common Lisp. QML is declarative — it matches Lisp's generation model.
- Desktop: native look and feel on Linux, macOS, and Windows.
- Mobile: Qt runs natively on iOS and Android. Android uses F-Droid for the unrestricted version and Play Store for sandboxed. iOS uses Guideline 4.7 ("Educational/Developer Tool" loophole, no JIT compilation).
- Safety Bridge for mobile: Lisp code can manipulate browser/files but cannot touch hardware (GPS, camera, contacts) without standard permission pop-ups.
- The minibuffer: a universal command line at the bottom of the screen. Not an Emacs modeline. Not a VS Code command palette. A single command surface for every action — edit files, navigate web, run Lisp expressions, invoke agent commands. ~M-x~ for everything.
*** Lish — the Common Lisp editor
Not elisp. Not Emacs. A multi-threaded Common Lisp editor rendered via Qt/QML. The complete system prompt lives in an Org buffer — the agent's identity, its skill registry, its memory, and its reasoning are visible and editable as Org text. The user modifies the agent's prompt and the agent reflects the change immediately — the prompt is a file in memory, not a hidden string in a config.
Org-babel for interactive evaluation: source blocks in Org files are executable. The user evaluates a ~#+begin_src lisp~ block and the result appears inline. The agent evaluates blocks to verify code before writing. The REPL is not a separate window — it is the Org buffer in which the agent and user both work.
The editor and the agent share the same Lisp image. The editor is not a client that connects to a daemon — it IS the daemon process. The TUI from v0.x is the editor's rendering surface.
*** Nyxt — the Common Lisp browser (three erosion stages)
The browser is not a one-time feature. It is a multi-year erosion of the rendering stack toward pure Lisp:
*Stage 1 — Qt + WebKit.* Qt provides window management and native widgets. WebKit renders web content inside a Lisp buffer. Network requests via dexador (pure Lisp). HTML parsed via Plump (pure Lisp). Layout via Yoga (C-based Flexbox, wrapped via FFI). JavaScript via embedded QuickJS. This stage delivers a working browser in months, not years.
*Stage 2 — S-expression DOM.* Lisp builds its own DOM representation as native S-expressions. WebKit is reduced to pixel painting only — it receives rendered layouts from Lisp, not raw HTML. The agent can traverse and manipulate the DOM as Lisp data structures without serialization. This makes web content natively queryable and modifiable by the agent's cognitive loop.
*Stage 3 — Pure Lisp layout.* WebKit turned off entirely. Lisp-native layout engine (12-18 months of focused development). CSS subset sufficient for the modern web's 95% use case. JavaScript via QuickJS remains for interactive content. The browser is now a Lisp application that happens to speak HTTP, not a web engine wrapped in a Lisp process.
*** Lish — the Lisp shell
Bash is a text-stream protocol. Passepartout speaks plists. The Lish shell replaces text streams with structured data — every command returns a plist, not a byte stream. Pipe becomes function composition. Scripts become Lisp functions that operate on memory objects directly.
The agent and the user share the same shell. The user types ~(list-todos :tag "@urgent")~. The agent proposes ~(shell "npm run build")~. The Dispatcher verifies both. The shell is not a separate process — it is a REPL connected to the same Lisp image as the agent's cognitive loop.
Org-mode buffers become the file system. The user's memex (~/memex/) is browsable as a tree of Org headlines. File operations (read, write, list, search) operate on Org AST nodes, not byte streams. A "directory listing" is a tree of headlines. A "file read" is a subtree rendered as text.
Bash remains available as a backend for running external commands, but it is not the primary interface.
*** Emacs migration — three phases
The Emacs bridge (v0.4.0) is Phase I. The deep integration is three phases, not one:
*Phase I — Parasite (v0.4.0).* Emacs is a client. The elisp TCP bridge sends text and receives responses. The agent does not control Emacs. Emacs users get a native chat experience alongside the TUI.
*Phase II — Interpreter (v2.0.0).* An ELisp compatibility layer runs inside Passepartout's Common Lisp image. Key Emacs packages (Org-mode, Magit) run natively without an Emacs process. The compatibility layer does not aim for 100% coverage — it targets the packages the agent's workflows depend on.
*Phase III — Successor (v2.0.0 and beyond).* Native Common Lisp implementations of Org-mode workflows and Git integration read/write the same file formats. Total independence from Emacs. Emacs users who prefer Emacs keep the bridge. New users get the native experience.
*** Strategic timeline
v0.4.0 Emacs bridge (Phase I Parasite) → v1.0.0 Neurosymbolic Maturity → v2.0.0 Lish editor + Nyxt browser (Stage 1) + Emacs Phase II/III + mobile. The Qt/QML surface enables gradual erosion of the rendering stack without rewriting the application logic. The three-phase Emacs migration ensures Lisp users are never abandoned — the bridge works from day one, the native experience grows under it.
* v3.0.0+: Cannibalization — Eat Your Dependencies
v3.0.0 begins the erosion of external dependencies — the system that was bootstrapped on Qt, WebKit, C runtime, and Linux starts replacing them piece by piece with native Lisp components. This is the realization of the Lisp Machine: not built from scratch, but arrived at through gradual replacement of a working system.
*** v3.0.0: Single-Process Convergence
- TCP bridge between daemon and EQL5 client becomes an internal function call
- One SBCL image: daemon + editor + shell + browser share one address space
- The wire protocol becomes nil — all communication is plist exchange in memory
*** v3.1.0: Lisp-Native Layout Engine
- Replace QML layout with Lisp layout (Yoga FFI as intermediate step)
- CLOS-based widget tree with computed dirty regions
- Diff-based redisplay: only changed cells re-render
*** v3.2.0: Browser Stage 2 — S-Expression DOM
- Lisp builds its own DOM as native s-expressions
- WebKit reduced to pixel painting only
- Agent traverses and manipulates DOM as Lisp data without serialization
*** v3.3.0: Browser Stage 3 — Pure Lisp Browser
- Lisp-native layout engine handles CSS subset
- JavaScript via QuickJS remains
- WebKit turned off entirely
- The browser is now a Lisp application
*** v3.4.0+: Qt/QML Erosion
- Replace QML components with Lisp-native widgets (one at a time)
- Window management via Lisp-native X11/Wayland bindings
- Font rendering via HarfBuzz FFI → Lisp replacement
- Event loop: Qt's → SBCL's native thread scheduler
- Each replacement is verified by the eval harness; the system remains usable at every step
*** v3.6.0: Stage0 Lisp Bootstrap
- 500-byte hex bootstrap → self-hosting Lisp
- Replace Linux bootloader
- The Lisp machine runs on bare metal
* v4.0.0: Native Inference
LLM inference moves in-process. No external servers. No API keys required for inference.
*Lisp as Sovereign Governor, not as Math Engine.* The weights themselves are not stored as Lisp objects — this would waste 50% memory on type tags and destroy cache locality through pointer-chasing. Instead, the entire tensor is tagged as a single Lisp object (~macro-tag~). The Lisp image holds a pointer to optimized flat binary (GPU-friendly, FPGA-compatible). The tag is checked once. After that, all math happens in the optimized backend.
** Native inference (FFI binding to llama.cpp)
- FFI binding to llama.cpp via CFFI: load GGUF models, run inference, manage KV cache. Single SBCL image, zero process boundaries. The agent and the model share memory.
- Speculative safety: the Dispatcher gate stack intercepts token generation in real time. A token that would produce a blocked action is preemptively suppressed before generation. No external inference API supports this.
- Foveal-peripheral compute: the model skips pruned context nodes during attention computation. External APIs compute full attention regardless of what you send. In-process inference makes the sparse-tree rendering pay off at the compute level, not just the token level.
** Live surgery on cognition
With in-process inference, the agent's internal state becomes inspectable:
- Pause inference mid-stream. Inspect hidden states and activations as Lisp variables.
- Modify a vector, change a sampling parameter, resume.
- Detect when the agent is likely to hallucinate by comparing current activation patterns against historical baselines.
- The REPL becomes a surgical instrument for the agent's own cognition — not just for verifying code, but for inspecting and correcting the neural process that generates it.
** DSL-compiled model architectures
Model architectures are described as Lisp DSL:
- ~(defmodel passepartout-reasoning :type 'transformer :heads 32 :dim 4096 :layers 32)~
- The DSL compiles to machine code for the target backend (GPU via CUDA, FPGA via VexRiscv, CPU via llama.cpp).
- Python interprets at runtime. Lisp compiles once. Model architecture changes are treated the same as code changes — edited, verified, hot-reloaded.
* v5.0.0: Hardware — Tagged Lisp Architecture
The Lisp machine becomes physical. RISC-V with tagged architecture, hardware-enforced type checking, and FPGA prototype for the symbolic core.
*Not a from-scratch processor.* Use RISC-V as the skeleton, add custom Lisp extensions. RISC-V provides the carrier architecture (standard instruction set, existing toolchain, LLVM support). Lisp extensions provide tagged computation (type checking in hardware, parallel garbage collection, S-expression traversal as atomic operations).
** The macro-tag approach
- Top 48 bits of every memory word = Type Tag. Hardware checks tags in parallel with ALU operations. Trap on type mismatch.
- A tensor (70B weights) is one macro-tagged Lisp object — a pointer to flat binary. The tag is checked once. Math happens at native speed. This replaces "weights as sexps" (which wastes 50% memory on per-weight tags and destroys cache locality).
- Custom instructions: TADD (tagged add), LISP.CAR, LISP.CDR — Lisp primitives as single-cycle hardware operations.
** Phase migration: Host → Co-processor → Self-hosted
1. *Parasitic.* Lisp card (FPGA) is a PCIe co-processor. Host CPU (Intel/AMD, Linux/Windows) handles "dirty" I/O — networking, display, file systems. Lisp card handles tagged computation and the agent's cognitive loop. If Lisp crashes, host survives. Reset card, reload. Memory mapping: the card can see the host's memory. The Lisp environment reaches out and inspects data.
2. *Functional Hijacking.* Lisp UI runs on the card, displays through the PC's GPU. The agent indexes Linux files into Lisp objects. The host becomes an I/O server for the Lisp card.
3. *Driver Cannibalization.* Point the agent at C drivers. Ask it to generate native Lisp drivers for the hardware the card controls directly. PCIe Passthrough for direct hardware access.
4. *Self-Hosting.* Replace the Linux bootloader with Stage0 Lisp (a bootstrap from 500 bytes of hex to a self-hosting Lisp). Cut the umbilical cord. The Lisp machine runs on bare metal.
** Concrete prototyping milestones
| Stage | Hardware | Cost | What it delivers |
|-------+----------+------+-----------------|
| TinyTapeout | Custom silicon (130nm) | ~$5001,000 | 8-bit tagged toy processor with Lisp primitives |
| Shuttle | Multi-project wafer | ~$10,00020,000 | Tagged RISC-V core at 100300MHz |
| FPGA | Terasic DE10-Nano / Xilinx KCU105 | ~$200500 | VexRiscv with custom Lisp extensions, PCIe card form factor |
| Industrial | Commercial foundry (5nm) | ~$10M100M+ | Competes with modern CPUs on tagged workloads |
Start at TinyTapeout. Validate the tagged architecture works. Move to FPGA. Validate at speed. Only then consider silicon.
** Garbage collection in hardware
Dedicated bus master (Scavenger) runs background garbage collection while the main CPU executes code. No "GC pause." The scavenger traverses the heap in parallel with computation, freeing unreachable objects without stopping the agent.
** Persistent single-address-space memory
NVRAM for the entire heap. Turn on the machine — state is exactly where you left it. No "booting." No "loading memory from disk." The agent's Merkle-tree memory, skill registry, knowledge graph, and induced functions survive restarts as a contiguous hardware state.
** Why this is not "Lisp inside browser"
Most Lisp-on-hardware attempts fail because they try to compete with Intel on raw math. That's the wrong axis. The tagged architecture doesn't need to beat a GPU at matrix multiplication. It needs to beat a CPU at symbolic computation — graph traversal, constraint solving, theorem proving, garbage collection. These are the v3.0.0 symbolic engine's workload. Hardware that makes them single-cycle is the differentiator, not hardware that runs matrix math faster.
* v6.0.0: True Agency
World models, temporal reasoning, goal persistence across restarts.
- World models: Predictive models of user behavior, project dynamics, system state.
- Temporal reasoning: Scheduling, deadlines, elapsed duration awareness.
- Goal persistence: Goals survive restarts. Long-term projects in memory-objects.
* Neurosymbolic Phase Reference
Each phase has a detailed implementation spec in its version section above. Summary of what is and isn't built:
| Phase | Component | Lines | Release |
|-------+-----------------------------------------+-------+----------|
| 0 | PM-type-level gates + core integrity | ~75 | v0.10.0 |
| 0b | Layered auth — Layer 1 (cryptographic) | ~200 | v0.12.0 |
| 1 | Triple fact store + abstract API | ~200 | v0.14.0 |
| 1a | Self-preservation mechanisms | ~120 | v0.16.0 |
| 2 | Screamer admission gate | ~200 | v0.18.0 |
| 3 | Archivist as fact proposer | ~100 | v0.20.0 |
| 4 | Sufficiency criterion — the flip | ~50 | v0.22.0 |
| 5 | VivaceGraph + Merkle DAG + ontology ver | ~400 | v0.25.0 |
| 6 | ACL2 structural verification | ~200 | v0.27.0 |
| 7 | 10-80-10 planner | ~500 | v0.36.0 |
| 8+ | Semantic Wikipedia integration | TBD | v0.36.1+ |
|-------+-----------------------------------------+-------+----------|
| Total | | ~2045 | |
** What Is NOT Built by the Neurosymbolic Phases
1. *A separate knowledge graph serialization format before the ephemeral phase proves what facts are useful.* Premature format commitment is the ontology problem writ small. Let use determine the format.
2. *ACL2 verification of empirical claims.* Apple is red. rm -rf / is destructive. These are observations, not theorems. Screamer handles empirical consistency. ACL2 handles structural verification.
3. *VivaceGraph before Screamer.* The admission gate is the critical path. The persistence layer is an optimization of a working system.
4. *A per-fact ontology designed upfront.* Extract from the gate stack, extend from deductions and observations, prune through contradiction detection. The ontology is a garden, not a building.
5. *New core ASDF components.* Every phase is a skill. A corrupted symbolic engine degrades reasoning but does not kill the agent. Satisfies the self-repair criterion.
6. *A "complete" symbolic index for the broad domain.* The neural index is the permanent gateway to the richness of prose. The symbolic index handles what can be mechanically verified. The boundary is permanent, not transitional. The neuro is the brain. The symbolic is the education.
** Competitive Advantage Analysis
*** Phase 0-1: Deterministic safety, now with type-level guarantees
The existing Dispatcher gate stack already provides 0-LLM-token safety verification. Phase 0 adds structural guarantees: no heuristic bypassing of the type hierarchy. A request to modify the dispatcher's own rules is impossible by construction, not just caught by pattern matching. No competitor has this — their equivalent of "core file protection" is a prompt instruction, not a type system.
*** Phase 0b: Layered signal authentication — verified origin, not claimed origin
No competitor verifies /who/ issued a signal. Every agent harness accepts signals from any source that speaks its protocol. A compromised dependency can impersonate any signal source. Passepartout's four-layer authentication gate makes signal source spoofing impossible at Layer 1 (cryptographic), detectable at Layers 2-3 (sensory + deterministic reasoning), and probabilistically flagged at Layer 4 (style analysis). The key registry has Merkle-hashed provenance — key creation, promotion, and revocation are auditable, versioned, and survivable across restarts.
*** Phase 2-3: Verified extraction — the symbolic index grows without corruption
No competitor verifies extracted facts against an existing knowledge base. Their memory systems (Claude Code's ~extractMemories~, Hermes's MemoryProvider, OpenClaw's session transcripts) record what the LLM /said/ happened, not what the system /proved/ happened. Passepartout's Screamer-gated admission makes the symbolic index a monotonic, verified structure. Facts are admitted because they are consistent, not because the LLM generated them.
*** Phase 4-5: Self-accelerating knowledge — the downward cost curve
The sufficiency criterion makes Passepartout's "cheaper over time" thesis measurable. As the ratio of non-lossy facts grows, LLM calls for extraction decrease. At sufficiency, extraction of known categories becomes deterministic. The downward cost curve is not a marketing claim — it is a structural property of the architecture, visible through the sufficiency score.
*** Phase 6-7: Provable plan soundness
No competitor verifies task plans against formal constraints. Claude Code plans in a single LLM call with no post-hoc verification. Hermes decomposes tasks into subtasks but does not prove them non-contradictory. Passepartout's ACL2-verified plans are structurally guaranteed to have no deadlocks, no dependency cycles, and no safety violations. The verification is a proof, not a prompt.
*** Phase 0-1a: Self-preservation — the agent knows when it is wounded
No competitor detects its own degradation. Claude Code, OpenCode, and Hermes all fail silently when a tool crashes or a dependency is missing — the agent keeps running, producing degraded output, never telling the user. Passepartout's quarantine system detects failing skills, unloads them automatically, and displays a degraded-mode indicator in the status bar. The external watchdog restarts the daemon if the process dies. The integrity monitor detects corrupted core files. The agent refuses to execute commands that would destroy its own runtime, explaining /why/ and redirecting to the safe termination path.
*** Semantic Wikipedia: Entity coverage at zero marginal cost
No competitor has a general-knowledge entity graph because no competitor has a symbolic engine to populate. Claude Code knows codebases; it doesn't know that Nabokov wrote /Pale Fire/ and lectured on Kafka. Passepartout with Wikidata loaded knows both, and the entity knowledge costs zero LLM tokens — it is loaded once as structured data and queried via VivaceGraph traversals.
*** The permanent competitive advantage
The competitive advantage is not any single feature. It is the architecture's ability to accumulate verified knowledge from four independent sources (gates, deduction, verified LLM proposals, human authoring) and to make that knowledge queryable with provenance. Competitors accumulate chat transcripts. Passepartout accumulates a provenanced, self-verifying knowledge graph. Transcripts become stale and unreliable. The knowledge graph becomes richer and more trustworthy with every session.
Design rationale is in:
- ~notes/passepartout-neurosymbolic-design-decisions-and-options.org~ — design rationale for every decision
- ~notes/passepartout-symbolic-engine-exploration.org~ — original architecture exploration
- ~notes/passepartout-whitehead.org~ — Whitehead's four concrete contributions
- ~docs/ARCHITECTURE.org~ — current pipeline architecture
- ~docs/DESIGN_DECISIONS.org~ — foundational architectural decisions

File diff suppressed because it is too large Load Diff

View File

@@ -1,5 +1,5 @@
(defpackage :passepartout.channel-tui
(:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
(:use :cl :passepartout :usocket :bordeaux-threads)
(:export :tui-main :st :add-msg :now :input-string
:queue-event :drain-queue :init-state
:view-status :view-chat :view-input :redraw
@@ -30,7 +30,7 @@
:rule-count :cyan :focus-map :yellow
;; UI
:dim :white :highlight :cyan :accent :green)
"Color theme plist. 27 semantic keys → Croatoan color values.
"Color theme plist. 27 semantic keys → hex color strings.
See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(defvar *tui-theme-presets*
@@ -65,43 +65,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:tool-running "#d33682" :tool-success "#859900" :tool-failure "#dc322f" :tool-output "#839496"
:scroll-indicator "#2aa198" :border "#657b83" :background "#002b36"
:rule-count "#2aa198" :focus-map "#b58900"
:dim "#586e75" :highlight "#2aa198" :accent "#859900")
:nord (:user "#81a1c1" :agent "#d8dee9" :system "#ebcb8b"
:input "#d8dee9" :timestamp "#4c566a" :help "#88c0d0" :error "#bf616a" :warning "#ebcb8b"
:connected "#a3be8c" :disconnected "#bf616a" :busy "#b48ead" :idle "#616e88"
:gate-passed "#a3be8c" :gate-blocked "#bf616a" :gate-approval "#ebcb8b"
:hitl "#b48ead"
:tool-running "#b48ead" :tool-success "#a3be8c" :tool-failure "#bf616a" :tool-output "#d8dee9"
:scroll-indicator "#88c0d0" :border "#4c566a" :background "#2e3440"
:rule-count "#88c0d0" :focus-map "#ebcb8b"
:dim "#616e88" :highlight "#88c0d0" :accent "#5e81ac")
:tokyonight (:user "#7aa2f7" :agent "#c0caf5" :system "#e0af68"
:input "#c0caf5" :timestamp "#565f89" :help "#7dcfff" :error "#f7768e" :warning "#e0af68"
:connected "#9ece6a" :disconnected "#f7768e" :busy "#bb9af7" :idle "#565f89"
:gate-passed "#9ece6a" :gate-blocked "#f7768e" :gate-approval "#e0af68"
:hitl "#bb9af7"
:tool-running "#bb9af7" :tool-success "#9ece6a" :tool-failure "#f7768e" :tool-output "#c0caf5"
:scroll-indicator "#7dcfff" :border "#1f2335" :background "#1a1b26"
:rule-count "#7dcfff" :focus-map "#e0af68"
:dim "#565f89" :highlight "#7dcfff" :accent "#7aa2f7")
:catppuccin (:user "#89b4fa" :agent "#cdd6f4" :system "#f9e2af"
:input "#cdd6f4" :timestamp "#585b70" :help "#94e2d5" :error "#f38ba8" :warning "#f9e2af"
:connected "#a6e3a1" :disconnected "#f38ba8" :busy "#cba6f7" :idle "#6c7086"
:gate-passed "#a6e3a1" :gate-blocked "#f38ba8" :gate-approval "#f9e2af"
:hitl "#cba6f7"
:tool-running "#cba6f7" :tool-success "#a6e3a1" :tool-failure "#f38ba8" :tool-output "#cdd6f4"
:scroll-indicator "#94e2d5" :border "#45475a" :background "#1e1e2e"
:rule-count "#94e2d5" :focus-map "#f9e2af"
:dim "#6c7086" :highlight "#94e2d5" :accent "#89b4fa")
:monokai (:user "#a6e22e" :agent "#f8f8f2" :system "#e6db74"
:input "#f8f8f2" :timestamp "#75715e" :help "#66d9ef" :error "#f92672" :warning "#e6db74"
:connected "#a6e22e" :disconnected "#f92672" :busy "#ae81ff" :idle "#75715e"
:gate-passed "#a6e22e" :gate-blocked "#f92672" :gate-approval "#e6db74"
:hitl "#ae81ff"
:tool-running "#ae81ff" :tool-success "#a6e22e" :tool-failure "#f92672" :tool-output "#f8f8f2"
:scroll-indicator "#66d9ef" :border "#49483e" :background "#272822"
:rule-count "#66d9ef" :focus-map "#e6db74"
:dim "#75715e" :highlight "#66d9ef" :accent "#a6e22e"))
:dim "#586e75" :highlight "#2aa198" :accent "#859900"))
"Named theme presets. /theme <name> loads one into *tui-theme*.")
(defvar *tui-theme-current-name* :dark
@@ -137,40 +101,15 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
key)))
(defun theme-color (role)
"Returns the Croatoan color for a semantic role.
Keyword or hex string values are returned as-is; hex strings are
converted to integers that Croatoan can process."
"Returns a hex color string for a semantic role, suitable for cl-tty."
(let ((val (or (getf *tui-theme* role) :white)))
(if (and (stringp val) (> (length val) 0) (eql (char val 0) #\#))
(handler-case (parse-integer (subseq val 1) :radix 16)
(error () val))
val)))
;; v0.8.0: TrueColor helpers
(defun theme-hex-to-rgb (hex-string)
"Parse #RRGGBB to (values r g b). Returns (255 255 255) for invalid input."
(if (and (stringp hex-string) (= 7 (length hex-string)) (eql (char hex-string 0) #\#))
(handler-case
(let ((r (parse-integer (subseq hex-string 1 3) :radix 16))
(g (parse-integer (subseq hex-string 3 5) :radix 16))
(b (parse-integer (subseq hex-string 5 7) :radix 16)))
(values r g b))
(error () (values 255 255 255)))
(values 255 255 255)))
(defun theme-init-truecolor ()
"Register hex colors from *tui-theme* with Croatoan's init-color."
(handler-case
(loop for (key val) on *tui-theme* by #'cddr
when (and (stringp val) (= 7 (length val)) (eql (char val 0) #\#))
do (multiple-value-bind (r g b) (theme-hex-to-rgb val)
(init-color key (/ r 255.0) (/ g 255.0) (/ b 255.0))))
(error () nil)))
(defun sidebar-toggle ()
"Toggle sidebar visibility. Sets dirty flags for full redraw."
(setf (st :sidebar-visible) (not (st :sidebar-visible)))
(setf (st :dirty) (list t t t)))
(cond
((stringp val) val)
(t (case val
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
(:white "#FFFFFF") (:black "#000000")
(t "#FFFFFF"))))))
(defun st (key) (getf *state* key))
(defun (setf st) (val key) (setf (getf *state* key) val))
@@ -188,14 +127,8 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:search-mode nil :search-query "" ; v0.7.2
:search-matches nil :search-match-idx 0
:sidebar-visible nil ; v0.8.0
:minibuffer-mode nil :minibuffer-selected-idx 0 ; v0.8.0
:minibuffer-filter "" ; v0.8.0
:wizard-mode :provider-list ; v0.9.0
:wizard-selected-idx 0 :wizard-input "" ; v0.9.0
:wizard-error nil ; v0.9.0
:wizard-providers nil :wizard-current-provider nil ; v0.9.0
:wizard-cascade '(:fg-prob nil :bg-prob nil :fg-det nil :bg-det nil) ; v0.9.0
:wizard-cascade-slot :fg-prob ; v0.9.0
:expand-tool-calls nil ; v0.8.0
:mcp-count 0 ; v0.8.0
:dirty (list nil nil nil))))
(defun now ()

View File

@@ -1,27 +1,53 @@
(in-package :passepartout.channel-tui)
(defun view-status (win)
(clear win)
(box win 0 0)
(add-string win
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 0)
(if (st :streaming-text) " [streaming]"
(if (st :busy) " …thinking" "")))
:y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0)
(let ((focus-info (or (st :foveal-id) "")))
(when (and focus-info (> (length focus-info) 0))
(add-string win (format nil " [Focus: ~a]" focus-info)
:y 2 :x 1 :fgcolor (theme-color :timestamp))))
(add-string win (format nil " ~a" (now))
:y 2 :x (max 1 (- (width win) 12))
:fgcolor (theme-color :timestamp))
(refresh win))
(defun word-wrap (text width)
"Wrap TEXT to at most WIDTH columns. Splits on word boundaries.
Returns a list of strings, one per line."
(let ((lines nil))
(loop while (> (length text) width)
do (let ((break (or (position #\Space text :end width :from-end t)
width)))
(push (subseq text 0 break) lines)
(setf text (string-left-trim '(#\Space)
(subseq text break)))))
(push text lines)
(nreverse lines)))
(defun view-status (fb w)
(let* ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout))
(member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout))
'(:degraded :unhealthy))))
(bg (if degraded :bright-yellow nil)))
;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy
(cl-tty.backend:draw-text fb 1 1
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 0)
(if (st :streaming-text) " [streaming]"
(if (st :busy) " …thinking" "")))
(theme-color (if (st :connected) :connected :disconnected)) bg)
;; Line 2: Focus + Timestamp
(let ((focus-info (or (st :foveal-id) "")))
(when (and focus-info (> (length focus-info) 0))
(cl-tty.backend:draw-text fb 1 2 (format nil " [Focus: ~a]" focus-info)
(theme-color :timestamp) bg)))
(cl-tty.backend:draw-text fb (max 1 (- w 12)) 2 (format nil " ~a" (now))
(theme-color :timestamp) bg)
;; Line 3: Directory, LSP, MCP, commands hint (v0.8.0)
(let* ((cwd (or (uiop:getenv "PWD") (uiop:getcwd)))
(dir (subseq cwd (max 0 (- (length cwd) (- w 45)))))
(lsp-color (if (st :connected) :green :dim))
(mcp-count (or (st :mcp-count) 0))
(hint " Ctrl+P: commands /help: help"))
(cl-tty.backend:draw-text fb 1 3 (format nil " ~a" dir) (theme-color :dim) bg)
(cl-tty.backend:draw-text fb (+ 2 (length dir)) 3 "●" (theme-color lsp-color) bg)
(cl-tty.backend:draw-text fb (+ 5 (length dir)) 3 (format nil " MCP:~d" mcp-count)
(theme-color :dim) bg)
(cl-tty.backend:draw-text fb (- w (length hint) 2) 3 hint (theme-color :timestamp) bg))))
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
(defun search-highlight (content query)
@@ -40,11 +66,8 @@
(setf result (concatenate 'string result (subseq content pos)))
(if (string= result "") content result))))
(defun view-chat (win h)
(clear win)
(box win 0 0)
(let* ((w (or (width win) 78))
(msgs (st :messages))
(defun view-chat (fb w h)
(let* ((msgs (st :messages))
(total (length msgs))
(max-lines (- h 2))
(is-search (st :search-mode))
@@ -56,7 +79,7 @@
(query (st :search-query))
(header (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
(length matches) query (1+ idx) (length matches))))
(add-string win header :y y :x 1 :n (1- w) :fgcolor (theme-color :highlight))
(cl-tty.backend:draw-text fb 1 y header (theme-color :highlight) nil)
(incf y)
(decf max-lines)))
;; Count visible messages from end, accounting for word wrap
@@ -65,14 +88,14 @@
(loop for i from (1- total) downto 0
while (> lines-remaining 0)
do (let* ((msg (aref msgs i))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(content-show (if is-search
(search-highlight content (st :search-query))
content))
(line-text (format nil "~a [~a] ~a" prefix time content-show))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(content-show (if is-search
(search-highlight content (st :search-query))
content))
(line-text (format nil "~a [~a] ~a" prefix time content-show))
(wrapped (word-wrap line-text (- w 2)))
(nlines (length wrapped)))
(if (<= nlines lines-remaining)
@@ -103,148 +126,32 @@
(theme-color :hitl))))
(dolist (line wrapped)
(when (< y (1- h))
(if (eq role :agent)
(let ((segments (parse-markdown-spans line)))
(setf y (render-styled win segments y 1 w)))
(progn
(add-string win line :y y :x 1 :n (1- w) :fgcolor color)
(incf y)))))
(cl-tty.backend:draw-text fb 1 y line color nil)
(incf y)))
;; v0.7.2: gate trace below agent messages
(let ((gate-trace (getf msg :gate-trace)))
(when (and gate-trace (not (member i (st :collapsed-gates))))
(dolist (entry (gate-trace-lines gate-trace))
(dolist (entry (passepartout::gate-trace-lines gate-trace))
(when (< y (1- h))
(add-string win (car entry) :y y :x 3 :n (- w 4) :fgcolor (or (getf (cdr entry) :fgcolor) :dim))
(incf y))))))))))
(refresh win))
(cl-tty.backend:draw-text fb 3 y (car entry)
(or (getf (cdr entry) :fgcolor) :dim) nil)
(incf y)))))))))))
(defun view-input (win)
(defun view-input (fb w)
(let* ((text (input-string))
(w (or (width win) 78))
(pos (or (st :cursor-pos) 0))
(display-start (max 0 (- pos (1- w))))
(visible (subseq text display-start (min (length text) (+ display-start w)))))
(clear win)
(add-string win (format nil "~a " visible) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 (min (- pos display-start) (1- w)))))
(refresh win))
(cl-tty.backend:draw-text fb 0 0 (format nil "~a " visible) (theme-color :input) nil)))
(defun redraw (sw cw ch iw)
(defun redraw (fb w h)
(destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw))
(when cd (view-chat cw ch))
(when id (view-input iw))
(setf (st :dirty) (list nil nil nil))))
(when sd (view-status fb w))
(when cd (view-chat fb w (- h 5)))
(when id (view-input fb w))
(setf (st :dirty) (list nil nil nil))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-tui-view-tests
(:use :cl :fiveam :passepartout)
(:export #:tui-view-suite))
(in-package :passepartout-tui-view-tests)
(def-suite tui-view-suite :description "TUI view rendering helpers")
(in-suite tui-view-suite)
(test test-char-width-ascii
"Contract 5: ASCII characters (< 128) have width 1."
(is (= 1 (char-width #\a)))
(is (= 1 (char-width #\Space)))
(is (= 1 (char-width #\@))))
(test test-char-width-tab
"Contract 5: tab character has width 8."
(is (= 8 (char-width #\Tab))))
(test test-char-width-cjk
"Contract 5: CJK characters have width 2."
(is (= 2 (char-width #\日))))
(test test-char-width-null
"Contract 5: null has width 0."
(is (= 0 (char-width #\Nul))))
(test test-markdown-bold
"Contract 7: parse-markdown-spans detects **bold**."
(let ((segments (parse-markdown-spans "hello **world**!")))
(is (= 3 (length segments)))))
(test test-markdown-plain
"Contract 7: plain text returns single segment."
(let ((segments (parse-markdown-spans "plain")))
(is (= 1 (length segments)))
(is (string= "plain" (caar segments)))))
(test test-markdown-url
"Contract 7: parse-markdown-spans detects URLs."
(let ((segments (parse-markdown-spans "see https://example.com for more")))
(is (>= (length segments) 2))
(is (find t segments :key (lambda (s) (getf (cdr s) :url))))))
(test test-markdown-blocks
"Contract 8: parse-markdown-blocks detects code blocks."
(let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
(segs (parse-markdown-blocks text)))
(is (= 3 (length segs)))
(let ((code (second segs)))
(is (eq t (getf code :code-block)))
(is (string= "lisp" (getf code :lang)))
(is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
(test test-markdown-blocks-no-close
"Contract 8: unclosed code block returns content."
(let* ((text (format nil "```~%unclosed code"))
(segs (parse-markdown-blocks text)))
(is (= 1 (length segs)))
(is (eq t (getf (first segs) :code-block)))))
(test test-syntax-highlight
"Contract 9: syntax-highlight colors Lisp code."
(let ((segs (syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
(is (>= (length segs) 3))))
(test test-syntax-highlight-keyword
"Contract 9: syntax-highlight colors keywords."
(let ((segs (syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
(is (>= (length segs) 2))
(is (find :keyword segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
(test test-syntax-highlight-function
"Contract 9: syntax-highlight colors function calls."
(let ((segs (syntax-highlight "(+ 1 2)" "lisp")))
(is (>= (length segs) 2))
(is (find :function segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
(test test-gate-trace-lines-passed
"Contract 9: gate-trace-lines for passed gate."
(let ((lines (gate-trace-lines
'((:gate "path" :result :passed)))))
(is (= 1 (length lines)))
(is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
(test test-gate-trace-lines-blocked
"Contract 9: gate-trace-lines for blocked gate."
(let ((lines (gate-trace-lines
'((:gate "shell" :result :blocked :reason "rm")))))
(is (= 1 (length lines)))
(is (search "rm" (caar lines)))))
(test test-gate-trace-lines-approval
"Contract 9: gate-trace-lines for approval gate."
(let ((lines (gate-trace-lines
'((:gate "network" :result :approval)))))
(is (= 1 (length lines)))
(is (search "HITL" (caar lines)))))
(test test-init-state-has-collapsed-gates
"Contract v0.7.2: init-state includes :collapsed-gates field."
(passepartout.channel-tui::init-state)
(let ((cg (passepartout.channel-tui::st :collapsed-gates)))
(is (null cg))))
(in-package :passepartout.channel-tui)
(in-package :passepartout)
(defun char-width (ch)
"Returns the terminal column width of character CH.
@@ -268,35 +175,7 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
((<= #xFE00 code #xFE0F) 0)
(t 1))))
(defun word-wrap (text max-width)
"Split TEXT into lines that fit within MAX-WIDTH columns.
Word-breaks at spaces when possible; breaks mid-word if necessary.
Respects CJK/emoji char widths via char-width."
(let ((lines nil)
(start 0)
(end (length text)))
(loop while (< start end) do
(let* ((col 0)
(pos start)
(last-break start))
(loop while (< pos end)
for width = (char-width (char text pos)) do
(when (char= (char text pos) #\Space)
(setf last-break pos))
(when (> (+ col width) max-width)
(return))
(incf col width)
(incf pos)
(when (>= pos end) (return)))
(let ((line-end (if (> pos start) pos (1+ start))))
(when (>= line-end end) (setf line-end end))
(push (subseq text start line-end) lines)
(setf start (if (and (< line-end end) (char= (char text line-end) #\Space))
(1+ line-end)
line-end)))))
(nreverse lines)))
(in-package :passepartout.channel-tui)
(in-package :passepartout)
(defun parse-markdown-spans (text)
"Parse inline markdown. Returns list of (text . (:bold/:underline/:code/:url ...))."
@@ -336,28 +215,22 @@ Respects CJK/emoji char widths via char-width."
(t (push (cons (subseq text pos) nil) results) (return))))))))
(nreverse results)))
(defun render-styled (win segments y x w)
"Render markdown segments to Croatoan window. Returns next y."
(defun render-styled (fb segments y x w)
"Render markdown segments to cl-tty backend. Returns next y."
(dolist (seg segments)
(when (>= y (height win)) (return y))
(let* ((text (or (car seg) ""))
(attrs (cdr seg))
(bold (getf attrs :bold))
(code (getf attrs :code))
(underline (getf attrs :underline))
(url (getf attrs :url))
(style-bits (append (when bold '(:bold))
(when underline '(:underline)))))
(when style-bits
(add-attributes win (get-bitmask style-bits)))
(add-string win text :y y :x x :n (max 1 (- w x))
:bgcolor (when code (theme-color :dim))
:fgcolor (cond (url (theme-color :highlight))
(t (theme-color (or (getf attrs :role) :agent)))))
(when style-bits
(remove-attributes win (get-bitmask style-bits)))
(url (getf attrs :url)))
(declare (ignore code))
(cl-tty.backend:draw-text fb x y text
(cond (url (theme-color :highlight))
(t (theme-color (or (getf attrs :role) :agent))))
nil
:bold bold)
(incf x (length text))))
(1+ y))
y)
(defun parse-markdown-blocks (text)
"Split text at ``` code block boundaries."
@@ -421,7 +294,7 @@ Respects CJK/emoji char widths via char-width."
(setf p fe)))))))))
(nreverse r)))
(in-package :passepartout.channel-tui)
(in-package :passepartout)
(defun gate-trace-lines (trace)
"Convert gate-trace plist to display lines."
@@ -432,14 +305,14 @@ Respects CJK/emoji char widths via char-width."
(reason (getf entry :reason))
(name (or gate "unknown"))
(color (case result
(:passed (theme-color :gate-passed))
(:blocked (theme-color :gate-blocked))
(:approval (theme-color :gate-approval))
(t (theme-color :dim))))
(:passed :gate-passed)
(:blocked :gate-blocked)
(:approval :gate-approval)
(t :dim)))
(prefix (case result
(:passed " ")
(:blocked " ")
(:approval " ")
(:passed " \u2713 ")
(:blocked " \u2717 ")
(:approval " \u2192 ")
(t " ? ")))
(text (format nil "~a~a~@[~a~]~@[~a~]"
prefix name
@@ -448,313 +321,110 @@ Respects CJK/emoji char widths via char-width."
(push (cons text (list :fgcolor color)) lines)))
(nreverse lines)))
(in-package :passepartout.channel-tui)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defun view-sidebar (win)
"Render 42-column sidebar with 7 panels: Gate Trace, Focus, Rules, Context, Files, Cost, Protection."
(clear win)
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(let* ((w (or (width win) 42))
(h (or (height win) 24))
(y 1)
(gate-trace (st :gate-trace))
(foveal-id (st :foveal-id))
(rule-count (or (st :rule-count) 0))
(context-usage (st :context-usage))
(modified-files (st :modified-files))
(session-cost (st :session-cost))
(block-counts (st :block-counts)))
;; Panel 1: Gate Trace
(add-string win "── Gate Trace ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(if gate-trace
(dolist (entry (gate-trace-lines gate-trace))
(when (< y (1- h))
(add-string win (car entry) :y y :x 2 :n (- w 4)
:fgcolor (or (getf (cdr entry) :fgcolor) (theme-color :dim)))
(incf y)))
(add-string win " (no trace)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
;; Panel 2: Focus
(incf y)
(add-string win "── Focus ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(add-string win (format nil " ~a" (or foveal-id "(none)")) :y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map))
;; Panel 3: Rules
(incf y 2)
(add-string win "── Rules ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(add-string win (format nil " Rules: ~d" rule-count) :y y :x 2 :n (- w 4) :fgcolor (theme-color :rule-count))
;; Panel 4: Context gauge
(incf y 2)
(add-string win "── Context ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(let* ((pct (or context-usage 0))
(bar-width 30)
(filled (min bar-width (floor (* pct bar-width) 100)))
(gauge-color (cond ((< pct 50) (theme-color :connected))
((< pct 80) (theme-color :warning))
((< pct 95) (theme-color :tool-running))
(t (theme-color :error)))))
(add-string win (format nil " [~a~a] ~d%"
(make-string filled :initial-element #\█)
(make-string (- bar-width filled) :initial-element #\░)
pct)
:y y :x 2 :n (- w 4) :fgcolor gauge-color))
;; Panel 5: Files
(incf y 2)
(add-string win "── Files ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(if modified-files
(dolist (f modified-files)
(when (< y (1- h))
(let ((fp (getf f :filepath))
(added (getf f :lines-added))
(removed (getf f :lines-removed)))
(add-string win (format nil " ~a~@[ +~d~]~@[ -~d~]"
(subseq fp (max 0 (- (length fp) 30)))
(when (> added 0) added)
(when (> removed 0) removed))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y))))
(add-string win " (no changes)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
;; Panel 6: Cost
(incf y 2)
(add-string win "── Cost ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(if session-cost
(progn
(add-string win (format nil " Total: $~,4f" (getf session-cost :total))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y)
(add-string win (format nil " Calls: ~d" (getf session-cost :calls))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)))
(add-string win " (no data)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
;; Panel 7: Protection
(incf y 2)
(add-string win "── Protection ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(if (and block-counts (> (getf block-counts :total) 0))
(let ((by-gate (getf block-counts :by-gate)))
(dolist (entry (subseq by-gate 0 (min (length by-gate) 6)))
(when (< y (1- h))
(add-string win (format nil " ~a: ~d" (car entry) (cdr entry))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :gate-blocked))
(incf y))))
(add-string win " (no blocks)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
(refresh win)
(- y 1)))
(defun view-minibuffer (win)
"Render the bottom-anchored minibuffer panel. Dispatches on :minibuffer-mode."
(case (st :minibuffer-mode)
(:slash-menu (view-slash-menu win))
(:wizard (view-wizard-in-panel win))
(t nil)))
(defvar *slash-commands* nil) ; forward declaration — defined in channel-tui-main
(defun view-slash-menu (win)
"Render the slash-command menu: filter bar, filtered command list, selection highlight."
(clear win)
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(let* ((w (or (width win) 60))
(h (or (height win) 10))
(y 1)
(filter (or (st :minibuffer-filter) ""))
(commands passepartout.channel-tui::*slash-commands*)
(filtered (if (or (null filter) (string= filter ""))
(mapcar (lambda (c) (list :index (position c commands) :cmd c)) commands)
(let ((q (string-downcase filter)) (i 0) (r nil))
(dolist (c commands (nreverse r))
(when (or (search q (string-downcase (getf c :name)))
(search q (string-downcase (or (getf c :desc) ""))))
(push (list :index i :cmd c) r))
(incf i)))))
(sel (or (st :minibuffer-selected-idx) 0))
(max-visible (- h 3)))
;; Header: filter bar
(add-string win (format nil " Commands") :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
(incf y)
(add-string win (format nil " > ~a_" (if (> (length filter) 0) filter "/"))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :input))
(incf y)
;; Command list
(if filtered
(let* ((start (max 0 (- sel (floor max-visible 2))))
(end (min (length filtered) (+ start max-visible)))
(flat-i 0))
(loop for entry across (subseq (coerce filtered 'vector) start end)
for fi from start
for cmd = (getf entry :cmd)
do (let* ((name (getf cmd :name))
(desc (getf cmd :desc))
(selected (= fi sel))
(fg (if selected (theme-color :highlight) (theme-color :agent))))
(when selected
(add-string win (make-string (- w 4) :initial-element #\Space) :y y :x 2 :n (- w 4)
:fgcolor (theme-color :dim) :bgcolor (theme-color :highlight)))
(let ((prefix (if selected " > " " ")))
(add-string win (format nil "~a~a" prefix name) :y y :x 3 :n (min (- w 6) 25) :fgcolor fg)
(when desc
(add-string win (format nil " — ~a" desc) :y y :x 28 :n (min (- w 30) (length desc)) :fgcolor (theme-color :dim))))
(incf y))))
(progn
(add-string win " (no matching commands)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(incf y)))
;; Footer
(add-string win " ↑↓ Navigate Enter Execute Esc Close"
:y (- h 0) :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(refresh win)
(- h 0)))
(defun view-wizard-in-panel (win)
"Render the setup wizard in the bottom-anchored minibuffer panel. Three modes: provider-list, key-entry, cascade-config."
(clear win)
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(let* ((w (or (width win) 70))
(h (or (height win) 14))
(y 1)
(mode (st :wizard-mode))
(error-msg (st :wizard-error))
(selected-idx (st :wizard-selected-idx))
(providers (passepartout.channel-tui::wizard-provider-list))
(configured (st :wizard-providers)))
(add-string win "Setup Wizard" :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
(incf y 2)
(case mode
(:provider-list
(let ((count (/ (length configured) 2)))
(add-string win (format nil "Configure Providers~a"
(if (> count 0) (format nil " — ~d configured" count) ""))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(incf y)
(loop for p in providers
for i from 0
do (let* ((meta (passepartout.channel-tui::wizard-provider-meta p))
(name (car meta))
(key (getf configured p))
(prefix (if (= i selected-idx) "> " " "))
(suffix (if key " ✓" ""))
(color (if (= i selected-idx)
(theme-color :highlight)
(theme-color :dim))))
(add-string win (format nil "~a~a~a" prefix name suffix)
:y y :x 3 :n (- w 6) :fgcolor color)
(incf y)))
(incf y)
(add-string win " Done — configure cascade"
:y y :x 3 :n (- w 6)
:fgcolor (if (>= selected-idx (length providers))
(theme-color :highlight)
(theme-color :dim)))
(when (>= selected-idx (length providers))
(add-string win ">" :y y :x 1 :n 2 :fgcolor (theme-color :highlight))))
(:key-entry
(let* ((provider (st :wizard-current-provider))
(meta (passepartout.channel-tui::wizard-provider-meta provider))
(name (car meta))
(url (cadr meta))
(input (or (st :wizard-input) "")))
(add-string win (format nil "API Key: ~a" name) :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y)
(when url
(add-string win (format nil "Get key at: ~a" url) :y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))
(incf y))
(add-string win "Enter your API key." :y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))
(incf y 2)
(add-string win (format nil "Key: > ~a" input) :y y :x 3 :n (- w 6) :fgcolor (theme-color :input))
(incf y)
(when error-msg
(add-string win (format nil "! ~a" error-msg) :y y :x 3 :n (- w 6) :fgcolor (theme-color :error))
(incf y))
(incf y)
(add-string win "Enter=Save Esc=Back Bksp=Edit Ctrl+U=Clear"
:y (- h 0) :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(return-from view-wizard-in-panel)))
(:cascade-config
(let* ((slot (st :wizard-cascade-slot))
(slot-providers (getf (st :wizard-cascade) slot))
(slot-label (cadr (assoc slot passepartout.channel-tui::*wizard-cascade-labels*)))
(count (/ (length configured) 2)))
(add-string win (format nil "Configure Cascade — ~d provider~:p" count)
:y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(incf y)
(add-string win (or slot-label "Unknown") :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
(incf y)
(let ((shown nil))
(loop for p in providers
for i from 0
do (when (getf configured p)
(let* ((meta (passepartout.channel-tui::wizard-provider-meta p))
(name (car meta))
(in-slot (member p slot-providers))
(prefix (if (= i selected-idx) "> " " "))
(mark (if in-slot " [✓]" " [ ]"))
(color (if (= i selected-idx)
(theme-color :highlight)
(if in-slot (theme-color :gate-passed) (theme-color :dim)))))
(add-string win (format nil "~a~a~a" prefix name mark)
:y y :x 3 :n (- w 6) :fgcolor color)
(incf y)
(push t shown))))
(unless shown
(add-string win " (no providers configured)"
:y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))
(incf y)))
(incf y)
(add-string win (format nil "Cascade: ~{~a~^, ~}"
(or slot-providers '("(none)")))
:y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))))
(when error-msg
(incf y)
(add-string win (format nil "! ~a" error-msg) :y y :x 3 :n (- w 6) :fgcolor (theme-color :error)))
(let ((footer (case mode
(:provider-list "↑↓ Navigate Enter=Select Esc=Back Ctrl+D=Remove")
(:cascade-config "↑↓ Select Enter=Toggle Tab=Next Quadrant Ctrl+S=Save Esc=Back")
(t ""))))
(when footer
(add-string win footer :y (- h 0) :x 2 :n (- w 4) :fgcolor (theme-color :dim))))
(- h 0)))))
(defpackage :passepartout-tui-view-tests
(:use :cl :fiveam :passepartout)
(:export #:tui-view-suite))
(in-package :passepartout-tui-view-tests)
(test test-theme-hex-string-keys-exist
"v0.8.0: all 27 theme keys are present in *tui-theme*."
(let* ((theme passepartout.channel-tui::*tui-theme*)
(required '(:user :agent :system :input :timestamp :help :error :warning
:connected :disconnected :busy :idle
:gate-passed :gate-blocked :gate-approval :hitl
:tool-running :tool-success :tool-failure :tool-output
:scroll-indicator :border :background
:rule-count :focus-map
:dim :highlight :accent)))
(dolist (key required)
(is (getf theme key) (format nil "~a should be defined" key)))))
(def-suite tui-view-suite :description "TUI view rendering helpers")
(in-suite tui-view-suite)
(test test-theme-presets-count
"v0.8.0: 8 presets defined: dark, light, solarized, gruvbox, nord, tokyonight, catppuccin, monokai."
(let* ((presets passepartout.channel-tui::*tui-theme-presets*)
(names '(:dark :light :solarized :gruvbox :nord :tokyonight :catppuccin :monokai)))
(dolist (name names)
(is (getf presets name) (format nil "~a preset should exist" name)))))
(test test-char-width-ascii
"Contract 5: ASCII characters (< 128) have width 1."
(is (= 1 (passepartout::char-width #\a)))
(is (= 1 (passepartout::char-width #\Space)))
(is (= 1 (passepartout::char-width #\@))))
(test test-minibuffer-init-state-fields
"Contract v0.8.0: init-state includes minibuffer-mode, selected-idx, filter; excludes palette and wizard-visible."
(test test-char-width-tab
"Contract 5: tab character has width 8."
(is (= 8 (passepartout::char-width #\Tab))))
(test test-char-width-cjk
"Contract 5: CJK characters have width 2."
(is (= 2 (passepartout::char-width #\日))))
(test test-char-width-null
"Contract 5: null has width 0."
(is (= 0 (passepartout::char-width #\Nul))))
(test test-markdown-bold
"Contract 7: parse-markdown-spans detects **bold**."
(let ((segments (passepartout::parse-markdown-spans "hello **world**!")))
(is (= 3 (length segments)))))
(test test-markdown-plain
"Contract 7: plain text returns single segment."
(let ((segments (passepartout::parse-markdown-spans "plain")))
(is (= 1 (length segments)))
(is (string= "plain" (caar segments)))))
(test test-markdown-url
"Contract 7: parse-markdown-spans detects URLs."
(let ((segments (passepartout::parse-markdown-spans "see https://example.com for more")))
(is (>= (length segments) 2))
(is (find t segments :key (lambda (s) (getf (cdr s) :url))))))
(test test-markdown-blocks
"Contract 8: parse-markdown-blocks detects code blocks."
(let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
(segs (passepartout::parse-markdown-blocks text)))
(is (= 3 (length segs)))
(let ((code (second segs)))
(is (eq t (getf code :code-block)))
(is (string= "lisp" (getf code :lang)))
(is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
(test test-markdown-blocks-no-close
"Contract 8: unclosed code block returns content."
(let* ((text (format nil "```~%unclosed code"))
(segs (passepartout::parse-markdown-blocks text)))
(is (= 1 (length segs)))
(is (eq t (getf (first segs) :code-block)))))
(test test-syntax-highlight
"Contract 9: syntax-highlight colors Lisp code."
(let ((segs (passepartout::syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
(is (>= (length segs) 3))))
(test test-syntax-highlight-keyword
"Contract 9: syntax-highlight colors keywords."
(let ((segs (passepartout::syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
(is (>= (length segs) 2))
(is (find :keyword segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
(test test-syntax-highlight-function
"Contract 9: syntax-highlight colors function calls."
(let ((segs (passepartout::syntax-highlight "(+ 1 2)" "lisp")))
(is (>= (length segs) 2))
(is (find :function segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
(test test-gate-trace-lines-passed
"Contract 9: gate-trace-lines for passed gate."
(let ((lines (passepartout::gate-trace-lines
'((:gate "path" :result :passed)))))
(is (= 1 (length lines)))
(is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
(test test-gate-trace-lines-blocked
"Contract 9: gate-trace-lines for blocked gate."
(let ((lines (passepartout::gate-trace-lines
'((:gate "shell" :result :blocked :reason "rm")))))
(is (= 1 (length lines)))
(is (search "rm" (caar lines)))))
(test test-gate-trace-lines-approval
"Contract 9: gate-trace-lines for approval gate."
(let ((lines (passepartout::gate-trace-lines
'((:gate "network" :result :approval)))))
(is (= 1 (length lines)))
(is (search "HITL" (caar lines)))))
(test test-init-state-has-collapsed-gates
"Contract v0.7.2: init-state includes :collapsed-gates field."
(passepartout.channel-tui::init-state)
(is (null (passepartout.channel-tui::st :minibuffer-mode)))
(is (= 0 (passepartout.channel-tui::st :minibuffer-selected-idx)))
(is (string= "" (passepartout.channel-tui::st :minibuffer-filter)))
(is (null (getf passepartout.channel-tui::*state* :palette-visible)))
(is (null (getf passepartout.channel-tui::*state* :wizard-visible))))
(test test-slash-commands-entry-count
"Contract v0.8.0: *slash-commands* has at least 19 entries, each with :name, :desc, :action."
(let ((cmds passepartout.channel-tui::*slash-commands*))
(is (>= (length cmds) 19))
(dolist (c cmds)
(is (stringp (getf c :name)))
(is (stringp (getf c :desc)))
(is (functionp (getf c :action))))))
(let ((cg (passepartout.channel-tui::st :collapsed-gates)))
(is (null cg))))

File diff suppressed because it is too large Load Diff

View File

@@ -6,66 +6,6 @@
The TUI state is a single plist accessed via ~st~ / ~(setf st)~.
All state mutation flows through event handlers in the controller.
** v0.8.0 — Information Radiator: Sidebar State
The sidebar is Passepartout's permanent UX differentiator — a 42-column
information panel that renders architectural data no competitor can display
because none has deterministic gates, foveal-peripheral context, or
rule-synthesizing Dispatcher to feed it. The sidebar makes the invisible
visible: seven panels of zero-LLM-token data from the deterministic layer,
always on screen when terminal width permits.
The sidebar reads its data from daemon response fields enriched by the
~:tui~ actuator in ~core-act.org~. All seven panels consume existing
infrastructure: gate trace from ~cognitive-verify~ (v0.4.0), focus from
~*loop-focus-id*~ (v0.3.0), rules from ~*hitl-pending*~ (v0.3.0), context
from ~token-economics~ (v0.5.0), files from tool execution tracking
(v0.8.0 new), cost from ~cost-tracker~ (v0.5.0), and block counts from
the Dispatcher (v0.8.0 new). Each field arrives as a daemon-response
plist key; the TUI stores them in state fields read by ~view-sidebar~.
When the terminal is narrower than 120 columns, the sidebar collapses to
an overlay toggled via ~/sidebar~ or ~Ctrl+X+B~. This preserves the
information radiator on constrained displays without sacrificing chat
area real estate.
State additions: ~:sidebar-visible~ (boolean), ~:block-counts~ (alist),
~:context-usage~ (integer 0-100), ~:modified-files~ (list of plists),
~:session-cost~ (plist).
** v0.8.0 — TrueColor Theme System
The existing theme system uses Croatoan's standard 8-color palette
(cyan, green, red, white, etc.). v0.8.0 upgrades to 24-bit TrueColor
via Croatoan's ~set-rgb~ / ~init-color~ primitives, enabling hex-specified
colors (#5E81AC, #BF616A, etc.) on supporting terminals (iTerm2, Kitty,
WezTerm, Windows Terminal, Ghostty).
The upgrade is backward compatible: terminals without TrueColor fall
back to the nearest standard color. Hex values are parsed by
~theme-hex-to-rgb~ (one-line format string → integer triple) and
registered once at theme-switch time via ~theme-init-truecolor~.
Subsequent ~theme-color~ lookups return the Croatoan color ID, same
API as the 8-color system.
Four new presets join the existing four (dark, light, solarized, gruvbox):
- ~:nord~ — blue-gray backgrounds, frost accent
- ~:tokyonight~ — purple-blue backgrounds, teal accent
- ~:catppuccin~ — warm pastels, mauve accent
- ~:monokai~ — dark brown backgrounds, orange accent
Each preset defines 27 hex color values, one per semantic key in
~*tui-theme*~. The 27 keys are:
roles (user, agent, system), content (input, timestamp, help, error,
warning), status (connected, disconnected, busy, idle), gate trace
(passed, blocked, approval, hitl), tools (running, success, failure,
output), display (scroll-indicator, border, background), differentiator
(rule-count, focus-map), and UI (dim, highlight, accent).
An audit ensures every key from ~*tui-theme*~ is consumed by at least one
rendering function in ~channel-tui-view.org~. Missing keys become invisible
theme presets — defined but unused.
** Contract
1. (init-state): returns a fresh state plist with ~:msgs~ list,
@@ -75,23 +15,11 @@ theme presets — defined but unused.
and optional gate-trace from the daemon (v0.4.0).
3. (queue-event ev): thread-safely enqueues an event for the
reader loop. (drain-queue) returns and clears the queue.
4. (theme-hex-to-rgb hex-string): parses ~"#RRGGBB"~ to
~(values r g b)~ integers 0-255. Returns ~(values 255 255 255)~
for unparseable input (v0.8.0).
5. (theme-init-truecolor): registers hex color values from
~*tui-theme*~ with Croatoan's ~init-color~ / ~set-rgb~. No-op
on terminals without TrueColor support (v0.8.0).
6. (theme-color key): extended contract (v0.8.0): if the ~*tui-theme*~
entry for ~key~ is a hex string, returns the Croatoan color ID
registered by ~theme-init-truecolor~. Falls back to keyword
lookup for non-hex entries and non-TrueColor terminals.
7. (sidebar-toggle): toggles ~:sidebar-visible~ state. Sets dirty
flags to force sidebar redraw (v0.8.0).
** Package + State
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
(defpackage :passepartout.channel-tui
(:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
(:use :cl :passepartout :usocket :bordeaux-threads)
(:export :tui-main :st :add-msg :now :input-string
:queue-event :drain-queue :init-state
:view-status :view-chat :view-input :redraw
@@ -122,7 +50,7 @@ theme presets — defined but unused.
:rule-count :cyan :focus-map :yellow
;; UI
:dim :white :highlight :cyan :accent :green)
"Color theme plist. 27 semantic keys → Croatoan color values.
"Color theme plist. 27 semantic keys → hex color strings.
See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(defvar *tui-theme-presets*
@@ -157,43 +85,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:tool-running "#d33682" :tool-success "#859900" :tool-failure "#dc322f" :tool-output "#839496"
:scroll-indicator "#2aa198" :border "#657b83" :background "#002b36"
:rule-count "#2aa198" :focus-map "#b58900"
:dim "#586e75" :highlight "#2aa198" :accent "#859900")
:nord (:user "#81a1c1" :agent "#d8dee9" :system "#ebcb8b"
:input "#d8dee9" :timestamp "#4c566a" :help "#88c0d0" :error "#bf616a" :warning "#ebcb8b"
:connected "#a3be8c" :disconnected "#bf616a" :busy "#b48ead" :idle "#616e88"
:gate-passed "#a3be8c" :gate-blocked "#bf616a" :gate-approval "#ebcb8b"
:hitl "#b48ead"
:tool-running "#b48ead" :tool-success "#a3be8c" :tool-failure "#bf616a" :tool-output "#d8dee9"
:scroll-indicator "#88c0d0" :border "#4c566a" :background "#2e3440"
:rule-count "#88c0d0" :focus-map "#ebcb8b"
:dim "#616e88" :highlight "#88c0d0" :accent "#5e81ac")
:tokyonight (:user "#7aa2f7" :agent "#c0caf5" :system "#e0af68"
:input "#c0caf5" :timestamp "#565f89" :help "#7dcfff" :error "#f7768e" :warning "#e0af68"
:connected "#9ece6a" :disconnected "#f7768e" :busy "#bb9af7" :idle "#565f89"
:gate-passed "#9ece6a" :gate-blocked "#f7768e" :gate-approval "#e0af68"
:hitl "#bb9af7"
:tool-running "#bb9af7" :tool-success "#9ece6a" :tool-failure "#f7768e" :tool-output "#c0caf5"
:scroll-indicator "#7dcfff" :border "#1f2335" :background "#1a1b26"
:rule-count "#7dcfff" :focus-map "#e0af68"
:dim "#565f89" :highlight "#7dcfff" :accent "#7aa2f7")
:catppuccin (:user "#89b4fa" :agent "#cdd6f4" :system "#f9e2af"
:input "#cdd6f4" :timestamp "#585b70" :help "#94e2d5" :error "#f38ba8" :warning "#f9e2af"
:connected "#a6e3a1" :disconnected "#f38ba8" :busy "#cba6f7" :idle "#6c7086"
:gate-passed "#a6e3a1" :gate-blocked "#f38ba8" :gate-approval "#f9e2af"
:hitl "#cba6f7"
:tool-running "#cba6f7" :tool-success "#a6e3a1" :tool-failure "#f38ba8" :tool-output "#cdd6f4"
:scroll-indicator "#94e2d5" :border "#45475a" :background "#1e1e2e"
:rule-count "#94e2d5" :focus-map "#f9e2af"
:dim "#6c7086" :highlight "#94e2d5" :accent "#89b4fa")
:monokai (:user "#a6e22e" :agent "#f8f8f2" :system "#e6db74"
:input "#f8f8f2" :timestamp "#75715e" :help "#66d9ef" :error "#f92672" :warning "#e6db74"
:connected "#a6e22e" :disconnected "#f92672" :busy "#ae81ff" :idle "#75715e"
:gate-passed "#a6e22e" :gate-blocked "#f92672" :gate-approval "#e6db74"
:hitl "#ae81ff"
:tool-running "#ae81ff" :tool-success "#a6e22e" :tool-failure "#f92672" :tool-output "#f8f8f2"
:scroll-indicator "#66d9ef" :border "#49483e" :background "#272822"
:rule-count "#66d9ef" :focus-map "#e6db74"
:dim "#75715e" :highlight "#66d9ef" :accent "#a6e22e"))
:dim "#586e75" :highlight "#2aa198" :accent "#859900"))
"Named theme presets. /theme <name> loads one into *tui-theme*.")
(defvar *tui-theme-current-name* :dark
@@ -229,40 +121,15 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
key)))
(defun theme-color (role)
"Returns the Croatoan color for a semantic role.
Keyword or hex string values are returned as-is; hex strings are
converted to integers that Croatoan can process."
"Returns a hex color string for a semantic role, suitable for cl-tty."
(let ((val (or (getf *tui-theme* role) :white)))
(if (and (stringp val) (> (length val) 0) (eql (char val 0) #\#))
(handler-case (parse-integer (subseq val 1) :radix 16)
(error () val))
val)))
;; v0.8.0: TrueColor helpers
(defun theme-hex-to-rgb (hex-string)
"Parse #RRGGBB to (values r g b). Returns (255 255 255) for invalid input."
(if (and (stringp hex-string) (= 7 (length hex-string)) (eql (char hex-string 0) #\#))
(handler-case
(let ((r (parse-integer (subseq hex-string 1 3) :radix 16))
(g (parse-integer (subseq hex-string 3 5) :radix 16))
(b (parse-integer (subseq hex-string 5 7) :radix 16)))
(values r g b))
(error () (values 255 255 255)))
(values 255 255 255)))
(defun theme-init-truecolor ()
"Register hex colors from *tui-theme* with Croatoan's init-color."
(handler-case
(loop for (key val) on *tui-theme* by #'cddr
when (and (stringp val) (= 7 (length val)) (eql (char val 0) #\#))
do (multiple-value-bind (r g b) (theme-hex-to-rgb val)
(init-color key (/ r 255.0) (/ g 255.0) (/ b 255.0))))
(error () nil)))
(defun sidebar-toggle ()
"Toggle sidebar visibility. Sets dirty flags for full redraw."
(setf (st :sidebar-visible) (not (st :sidebar-visible)))
(setf (st :dirty) (list t t t)))
(cond
((stringp val) val)
(t (case val
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
(:white "#FFFFFF") (:black "#000000")
(t "#FFFFFF"))))))
(defun st (key) (getf *state* key))
(defun (setf st) (val key) (setf (getf *state* key) val))
@@ -280,19 +147,13 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:search-mode nil :search-query "" ; v0.7.2
:search-matches nil :search-match-idx 0
:sidebar-visible nil ; v0.8.0
:minibuffer-mode nil :minibuffer-selected-idx 0 ; v0.8.0
:minibuffer-filter "" ; v0.8.0
:wizard-mode :provider-list ; v0.9.0
:wizard-selected-idx 0 :wizard-input "" ; v0.9.0
:wizard-error nil ; v0.9.0
:wizard-providers nil :wizard-current-provider nil ; v0.9.0
:wizard-cascade '(:fg-prob nil :bg-prob nil :fg-det nil :bg-det nil) ; v0.9.0
:wizard-cascade-slot :fg-prob ; v0.9.0
:expand-tool-calls nil ; v0.8.0
:mcp-count 0 ; v0.8.0
:dirty (list nil nil nil))))
#+end_src
#+END_SRC
** Helpers
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
(defun now ()
(multiple-value-bind (s m h) (get-decoded-time)
(declare (ignore s))
@@ -326,10 +187,10 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(unless (st :scroll-at-bottom)
(setf (st :scroll-notify) t))
(setf (st :dirty) (list t t nil)))
#+end_src
#+END_SRC
** Event Queue
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
(defun queue-event (ev)
(bt:with-lock-held (*event-lock*) (push ev *event-queue*)))
@@ -337,4 +198,4 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(bt:with-lock-held (*event-lock*)
(let ((evs (nreverse *event-queue*)))
(setf *event-queue* nil) evs)))
#+end_src
#+END_SRC

View File

@@ -3,91 +3,8 @@
* View
Pure render functions. Each takes a Croatoan window and current state.
State is read via ~(st :key)~ — no mutation here.
** v0.8.0 — Sidebar: The Information Radiator
The sidebar is Passepartout's permanent UX differentiator. No competitor
can render gate traces, focus maps, or rule counters because none has
deterministic gates, foveal-peripheral context, or rule synthesis. The
sidebar makes this data permanently visible in a 42-column panel at the
right of the terminal.
Seven panels stack vertically:
1. *Gate Trace* — per-message trace from the most recent agent response,
colored by gate state: green for passed, red for blocked, yellow for
HITL-required. Mirrors the per-message gate trace from v0.7.2 but
always visible.
2. *Focus* — the current foveal node ID from ~*loop-focus-id*~ plus a
related-node count from the last context assembly. Shows the user
what the agent is "looking at."
3. *Rules* — the Dispatcher's ~*hitl-pending*~ count with a progress bar
toward certification threshold. Shows how many user decisions the
Dispatcher has learned from.
4. *Context* — token gauge bar with percentage and color coding (green
< 50%, yellow 50-80%, orange 80-95%, red > 95%). Data from
~token-economics~ ~context-usage-percentage~.
5. *Files* — list of files modified in the most recent tool execution.
Each entry shows filepath and +/- line count where computable.
6. *Cost* — session cost from ~cost-tracker~: total USD spent, call
count, per-provider breakdown.
7. *Protection* — gate effectiveness counter from the Dispatcher's
~*dispatcher-block-counts*~: how many actions each gate blocked this
session. This is the specific-value-proposition panel — no competitor
has deterministic gates to count.
The sidebar is a fourth Croatoan window at the right of the terminal when
width ≥ 120 columns. At < 120 columns, it becomes an absolute-positioned
overlay toggled via ~/sidebar~ or ~Ctrl+X+B~. The overlay uses the same
rendering function (~view-sidebar~) and same data paths.
** v0.8.0 — Command Palette
The command palette provides a single discoverable entry point for all
TUI commands. Currently, commands are invisible — the user must know
~/help~ exists to discover ~/focus~, ~/rewind~, ~/context~, etc. The
palette solves this with a fuzzy-searchable overlay (Ctrl+P) organized
by category:
- *Session*~/focus~, ~/scope~, ~/unfocus~, ~/rename~
- *Agent*~/approve~, ~/deny~, ~/why~, ~/audit~, ~/context~
- *View*~/theme~, ~/sidebar~, ~/search~, ~/clear~
- *System*~/eval~, ~/status~, ~/reconnect~, ~/quit~
The palette renders as a centered Croatoan window overlay. Typing
filters items by fuzzy substring match on both command name and
description. Up/Down navigates; Enter executes; Esc dismisses.
Keyboard shortcuts (Ctrl+G, Ctrl+F, Ctrl+D, etc.) are displayed
as hints next to each item.
This mirrors OpenCode's command palette pattern — a proven UX
convention that makes power commands discoverable without reading
documentation.
** v0.8.0 — TUI Setup Wizard (deferred from v0.7.0)
The TUI setup wizard replaces the terminal-based ~passepartout configure~
flow with an in-TUI onboarding sequence. Users select LLM providers,
enter API keys, and verify connections — all within the same interface
they'll use daily.
The wizard is a multi-step overlay with progress indicator. Each step
defines a title, prompt text, validation function, and next-step function.
On validation failure, the step displays an error and stays on the current
step. On success, it advances. The last step writes configuration to
~.env~ and triggers daemon reload.
The wizard reuses the overlay infrastructure built for the command
palette and sidebar — same window creation patterns, same Croatoan
rendering primitives.
|Pure render functions. Each takes the cl-tty backend and current state.
|State is read via ~(st :key)~ — no mutation here.
** Contract
@@ -106,23 +23,6 @@ rendering primitives.
Tab = 8. Used by word-wrap for accurate line counting (v0.7.0).
6. (view-status win): v0.7.0 — timestamp right-aligned at (- w 12)
on line 2, focus info at :x 1. No overlap.
7. (redraw sw cw sidebar-w ch iw): v0.8.0 — redraw dispatches to
five windows: status, chat, sidebar (when visible and ≥120 cols),
input. In overlay mode (<120 cols), sidebar is rendered as an
absolute-positioned overlay window on top of chat.
8. (view-sidebar window): renders 42-column sidebar with 7 panels
stacked vertically: Gate Trace, Focus, Rules, Context gauge,
Files, Cost, Protection. Each panel title uses ~:accent~ color.
Returns number of lines rendered (v0.8.0).
9. (view-palette window items filter-query selected-idx): renders
command palette as centered overlay (~60% width, ~50% height).
Shows category headers, filtered items with highlighted selection,
keyboard shortcut hints. Scrolls when items exceed available
height (v0.8.0).
10. (view-wizard window step input error): renders setup wizard UI:
step title (~:accent~), prompt text (~:agent~), input area,
error message in ~:error~ color, progress indicator "Step N/M"
at bottom (v0.8.0).
** Status Bar
@@ -142,31 +42,57 @@ architecture:
All three enrichments cost 0 LLM tokens — they are daemon-state queries
that the TUI actuator attaches to the response plist before transmission.
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout.channel-tui)
(defun view-status (win)
(clear win)
(box win 0 0)
(add-string win
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 0)
(if (st :streaming-text) " [streaming]"
(if (st :busy) " …thinking" "")))
:y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0)
(let ((focus-info (or (st :foveal-id) "")))
(when (and focus-info (> (length focus-info) 0))
(add-string win (format nil " [Focus: ~a]" focus-info)
:y 2 :x 1 :fgcolor (theme-color :timestamp))))
(add-string win (format nil " ~a" (now))
:y 2 :x (max 1 (- (width win) 12))
:fgcolor (theme-color :timestamp))
(refresh win))
(defun word-wrap (text width)
"Wrap TEXT to at most WIDTH columns. Splits on word boundaries.
Returns a list of strings, one per line."
(let ((lines nil))
(loop while (> (length text) width)
do (let ((break (or (position #\Space text :end width :from-end t)
width)))
(push (subseq text 0 break) lines)
(setf text (string-left-trim '(#\Space)
(subseq text break)))))
(push text lines)
(nreverse lines)))
(defun view-status (fb w)
(let* ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout))
(member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout))
'(:degraded :unhealthy))))
(bg (if degraded :bright-yellow nil)))
;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy
(cl-tty.backend:draw-text fb 1 1
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 0)
(if (st :streaming-text) " [streaming]"
(if (st :busy) " …thinking" "")))
(theme-color (if (st :connected) :connected :disconnected)) bg)
;; Line 2: Focus + Timestamp
(let ((focus-info (or (st :foveal-id) "")))
(when (and focus-info (> (length focus-info) 0))
(cl-tty.backend:draw-text fb 1 2 (format nil " [Focus: ~a]" focus-info)
(theme-color :timestamp) bg)))
(cl-tty.backend:draw-text fb (max 1 (- w 12)) 2 (format nil " ~a" (now))
(theme-color :timestamp) bg)
;; Line 3: Directory, LSP, MCP, commands hint (v0.8.0)
(let* ((cwd (or (uiop:getenv "PWD") (uiop:getcwd)))
(dir (subseq cwd (max 0 (- (length cwd) (- w 45)))))
(lsp-color (if (st :connected) :green :dim))
(mcp-count (or (st :mcp-count) 0))
(hint " Ctrl+P: commands /help: help"))
(cl-tty.backend:draw-text fb 1 3 (format nil " ~a" dir) (theme-color :dim) bg)
(cl-tty.backend:draw-text fb (+ 2 (length dir)) 3 "●" (theme-color lsp-color) bg)
(cl-tty.backend:draw-text fb (+ 5 (length dir)) 3 (format nil " MCP:~d" mcp-count)
(theme-color :dim) bg)
(cl-tty.backend:draw-text fb (- w (length hint) 2) 3 hint (theme-color :timestamp) bg))))
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
(defun search-highlight (content query)
@@ -185,11 +111,8 @@ that the TUI actuator attaches to the response plist before transmission.
(setf result (concatenate 'string result (subseq content pos)))
(if (string= result "") content result))))
(defun view-chat (win h)
(clear win)
(box win 0 0)
(let* ((w (or (width win) 78))
(msgs (st :messages))
(defun view-chat (fb w h)
(let* ((msgs (st :messages))
(total (length msgs))
(max-lines (- h 2))
(is-search (st :search-mode))
@@ -201,7 +124,7 @@ that the TUI actuator attaches to the response plist before transmission.
(query (st :search-query))
(header (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
(length matches) query (1+ idx) (length matches))))
(add-string win header :y y :x 1 :n (1- w) :fgcolor (theme-color :highlight))
(cl-tty.backend:draw-text fb 1 y header (theme-color :highlight) nil)
(incf y)
(decf max-lines)))
;; Count visible messages from end, accounting for word wrap
@@ -210,14 +133,14 @@ that the TUI actuator attaches to the response plist before transmission.
(loop for i from (1- total) downto 0
while (> lines-remaining 0)
do (let* ((msg (aref msgs i))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(content-show (if is-search
(search-highlight content (st :search-query))
content))
(line-text (format nil "~a [~a] ~a" prefix time content-show))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(content-show (if is-search
(search-highlight content (st :search-query))
content))
(line-text (format nil "~a [~a] ~a" prefix time content-show))
(wrapped (word-wrap line-text (- w 2)))
(nlines (length wrapped)))
(if (<= nlines lines-remaining)
@@ -248,160 +171,41 @@ that the TUI actuator attaches to the response plist before transmission.
(theme-color :hitl))))
(dolist (line wrapped)
(when (< y (1- h))
(if (eq role :agent)
(let ((segments (parse-markdown-spans line)))
(setf y (render-styled win segments y 1 w)))
(progn
(add-string win line :y y :x 1 :n (1- w) :fgcolor color)
(incf y)))))
(cl-tty.backend:draw-text fb 1 y line color nil)
(incf y)))
;; v0.7.2: gate trace below agent messages
(let ((gate-trace (getf msg :gate-trace)))
(when (and gate-trace (not (member i (st :collapsed-gates))))
(dolist (entry (gate-trace-lines gate-trace))
(dolist (entry (passepartout::gate-trace-lines gate-trace))
(when (< y (1- h))
(add-string win (car entry) :y y :x 3 :n (- w 4) :fgcolor (or (getf (cdr entry) :fgcolor) :dim))
(incf y))))))))))
(refresh win))
#+end_src
(cl-tty.backend:draw-text fb 3 y (car entry)
(or (getf (cdr entry) :fgcolor) :dim) nil)
(incf y)))))))))))
#+END_SRC
** Input Line
#+begin_src lisp
(defun view-input (win)
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(defun view-input (fb w)
(let* ((text (input-string))
(w (or (width win) 78))
(pos (or (st :cursor-pos) 0))
(display-start (max 0 (- pos (1- w))))
(visible (subseq text display-start (min (length text) (+ display-start w)))))
(clear win)
(add-string win (format nil "~a " visible) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 (min (- pos display-start) (1- w)))))
(refresh win))
(cl-tty.backend:draw-text fb 0 0 (format nil "~a " visible) (theme-color :input) nil)))
#+end_src
** Redraw (dirty-flag dispatch)
#+begin_src lisp
(defun redraw (sw cw ch iw)
(defun redraw (fb w h)
(destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw))
(when cd (view-chat cw ch))
(when id (view-input iw))
(setf (st :dirty) (list nil nil nil))))
#+end_src
* Test Suite
#+begin_src lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-tui-view-tests
(:use :cl :fiveam :passepartout)
(:export #:tui-view-suite))
(in-package :passepartout-tui-view-tests)
(def-suite tui-view-suite :description "TUI view rendering helpers")
(in-suite tui-view-suite)
(test test-char-width-ascii
"Contract 5: ASCII characters (< 128) have width 1."
(is (= 1 (char-width #\a)))
(is (= 1 (char-width #\Space)))
(is (= 1 (char-width #\@))))
(test test-char-width-tab
"Contract 5: tab character has width 8."
(is (= 8 (char-width #\Tab))))
(test test-char-width-cjk
"Contract 5: CJK characters have width 2."
(is (= 2 (char-width #\日))))
(test test-char-width-null
"Contract 5: null has width 0."
(is (= 0 (char-width #\Nul))))
(test test-markdown-bold
"Contract 7: parse-markdown-spans detects **bold**."
(let ((segments (parse-markdown-spans "hello **world**!")))
(is (= 3 (length segments)))))
(test test-markdown-plain
"Contract 7: plain text returns single segment."
(let ((segments (parse-markdown-spans "plain")))
(is (= 1 (length segments)))
(is (string= "plain" (caar segments)))))
(test test-markdown-url
"Contract 7: parse-markdown-spans detects URLs."
(let ((segments (parse-markdown-spans "see https://example.com for more")))
(is (>= (length segments) 2))
(is (find t segments :key (lambda (s) (getf (cdr s) :url))))))
(test test-markdown-blocks
"Contract 8: parse-markdown-blocks detects code blocks."
(let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
(segs (parse-markdown-blocks text)))
(is (= 3 (length segs)))
(let ((code (second segs)))
(is (eq t (getf code :code-block)))
(is (string= "lisp" (getf code :lang)))
(is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
(test test-markdown-blocks-no-close
"Contract 8: unclosed code block returns content."
(let* ((text (format nil "```~%unclosed code"))
(segs (parse-markdown-blocks text)))
(is (= 1 (length segs)))
(is (eq t (getf (first segs) :code-block)))))
(test test-syntax-highlight
"Contract 9: syntax-highlight colors Lisp code."
(let ((segs (syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
(is (>= (length segs) 3))))
(test test-syntax-highlight-keyword
"Contract 9: syntax-highlight colors keywords."
(let ((segs (syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
(is (>= (length segs) 2))
(is (find :keyword segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
(test test-syntax-highlight-function
"Contract 9: syntax-highlight colors function calls."
(let ((segs (syntax-highlight "(+ 1 2)" "lisp")))
(is (>= (length segs) 2))
(is (find :function segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
(test test-gate-trace-lines-passed
"Contract 9: gate-trace-lines for passed gate."
(let ((lines (gate-trace-lines
'((:gate "path" :result :passed)))))
(is (= 1 (length lines)))
(is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
(test test-gate-trace-lines-blocked
"Contract 9: gate-trace-lines for blocked gate."
(let ((lines (gate-trace-lines
'((:gate "shell" :result :blocked :reason "rm")))))
(is (= 1 (length lines)))
(is (search "rm" (caar lines)))))
(test test-gate-trace-lines-approval
"Contract 9: gate-trace-lines for approval gate."
(let ((lines (gate-trace-lines
'((:gate "network" :result :approval)))))
(is (= 1 (length lines)))
(is (search "HITL" (caar lines)))))
(test test-init-state-has-collapsed-gates
"Contract v0.7.2: init-state includes :collapsed-gates field."
(passepartout.channel-tui::init-state)
(let ((cg (passepartout.channel-tui::st :collapsed-gates)))
(is (null cg))))
#+end_src
(when sd (view-status fb w))
(when cd (view-chat fb w (- h 5)))
(when id (view-input fb w))
(setf (st :dirty) (list nil nil nil))))
#+END_SRC
* Implementation — v0.7.0 additions
#+begin_src lisp
(in-package :passepartout.channel-tui)
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout)
(defun char-width (ch)
"Returns the terminal column width of character CH.
@@ -424,39 +228,11 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
((<= #x20D0 code #x20FF) 0)
((<= #xFE00 code #xFE0F) 0)
(t 1))))
(defun word-wrap (text max-width)
"Split TEXT into lines that fit within MAX-WIDTH columns.
Word-breaks at spaces when possible; breaks mid-word if necessary.
Respects CJK/emoji char widths via char-width."
(let ((lines nil)
(start 0)
(end (length text)))
(loop while (< start end) do
(let* ((col 0)
(pos start)
(last-break start))
(loop while (< pos end)
for width = (char-width (char text pos)) do
(when (char= (char text pos) #\Space)
(setf last-break pos))
(when (> (+ col width) max-width)
(return))
(incf col width)
(incf pos)
(when (>= pos end) (return)))
(let ((line-end (if (> pos start) pos (1+ start))))
(when (>= line-end end) (setf line-end end))
(push (subseq text start line-end) lines)
(setf start (if (and (< line-end end) (char= (char text line-end) #\Space))
(1+ line-end)
line-end)))))
(nreverse lines)))
#+end_src
#+END_SRC
* v0.7.1 — Markdown Rendering
#+begin_src lisp
(in-package :passepartout.channel-tui)
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout)
(defun parse-markdown-spans (text)
"Parse inline markdown. Returns list of (text . (:bold/:underline/:code/:url ...))."
@@ -496,28 +272,22 @@ Respects CJK/emoji char widths via char-width."
(t (push (cons (subseq text pos) nil) results) (return))))))))
(nreverse results)))
(defun render-styled (win segments y x w)
"Render markdown segments to Croatoan window. Returns next y."
(defun render-styled (fb segments y x w)
"Render markdown segments to cl-tty backend. Returns next y."
(dolist (seg segments)
(when (>= y (height win)) (return y))
(let* ((text (or (car seg) ""))
(attrs (cdr seg))
(bold (getf attrs :bold))
(code (getf attrs :code))
(underline (getf attrs :underline))
(url (getf attrs :url))
(style-bits (append (when bold '(:bold))
(when underline '(:underline)))))
(when style-bits
(add-attributes win (get-bitmask style-bits)))
(add-string win text :y y :x x :n (max 1 (- w x))
:bgcolor (when code (theme-color :dim))
:fgcolor (cond (url (theme-color :highlight))
(t (theme-color (or (getf attrs :role) :agent)))))
(when style-bits
(remove-attributes win (get-bitmask style-bits)))
(url (getf attrs :url)))
(declare (ignore code))
(cl-tty.backend:draw-text fb x y text
(cond (url (theme-color :highlight))
(t (theme-color (or (getf attrs :role) :agent))))
nil
:bold bold)
(incf x (length text))))
(1+ y))
y)
(defun parse-markdown-blocks (text)
"Split text at ``` code block boundaries."
@@ -580,11 +350,11 @@ Respects CJK/emoji char widths via char-width."
:keyword :function))) r)
(setf p fe)))))))))
(nreverse r)))
#+end_src
#+END_SRC
* v0.7.2 — Gate Trace
#+begin_src lisp
(in-package :passepartout.channel-tui)
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout)
(defun gate-trace-lines (trace)
"Convert gate-trace plist to display lines."
@@ -595,14 +365,14 @@ Respects CJK/emoji char widths via char-width."
(reason (getf entry :reason))
(name (or gate "unknown"))
(color (case result
(:passed (theme-color :gate-passed))
(:blocked (theme-color :gate-blocked))
(:approval (theme-color :gate-approval))
(t (theme-color :dim))))
(:passed :gate-passed)
(:blocked :gate-blocked)
(:approval :gate-approval)
(t :dim)))
(prefix (case result
(:passed " ")
(:blocked " ")
(:approval " ")
(:passed " \u2713 ")
(:blocked " \u2717 ")
(:approval " \u2192 ")
(t " ? ")))
(text (format nil "~a~a~@[~a~]~@[~a~]"
prefix name
@@ -610,322 +380,115 @@ Respects CJK/emoji char widths via char-width."
(if (eq result :approval) " (HITL required)" ""))))
(push (cons text (list :fgcolor color)) lines)))
(nreverse lines)))
#+end_src
#+END_SRC
* v0.8.0 — Sidebar + Minibuffer View
#+begin_src lisp
(in-package :passepartout.channel-tui)
* Test Suite
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defun view-sidebar (win)
"Render 42-column sidebar with 7 panels: Gate Trace, Focus, Rules, Context, Files, Cost, Protection."
(clear win)
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(let* ((w (or (width win) 42))
(h (or (height win) 24))
(y 1)
(gate-trace (st :gate-trace))
(foveal-id (st :foveal-id))
(rule-count (or (st :rule-count) 0))
(context-usage (st :context-usage))
(modified-files (st :modified-files))
(session-cost (st :session-cost))
(block-counts (st :block-counts)))
;; Panel 1: Gate Trace
(add-string win "── Gate Trace ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(if gate-trace
(dolist (entry (gate-trace-lines gate-trace))
(when (< y (1- h))
(add-string win (car entry) :y y :x 2 :n (- w 4)
:fgcolor (or (getf (cdr entry) :fgcolor) (theme-color :dim)))
(incf y)))
(add-string win " (no trace)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
;; Panel 2: Focus
(incf y)
(add-string win "── Focus ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(add-string win (format nil " ~a" (or foveal-id "(none)")) :y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map))
;; Panel 3: Rules
(incf y 2)
(add-string win "── Rules ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(add-string win (format nil " Rules: ~d" rule-count) :y y :x 2 :n (- w 4) :fgcolor (theme-color :rule-count))
;; Panel 4: Context gauge
(incf y 2)
(add-string win "── Context ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(let* ((pct (or context-usage 0))
(bar-width 30)
(filled (min bar-width (floor (* pct bar-width) 100)))
(gauge-color (cond ((< pct 50) (theme-color :connected))
((< pct 80) (theme-color :warning))
((< pct 95) (theme-color :tool-running))
(t (theme-color :error)))))
(add-string win (format nil " [~a~a] ~d%"
(make-string filled :initial-element #\█)
(make-string (- bar-width filled) :initial-element #\░)
pct)
:y y :x 2 :n (- w 4) :fgcolor gauge-color))
;; Panel 5: Files
(incf y 2)
(add-string win "── Files ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(if modified-files
(dolist (f modified-files)
(when (< y (1- h))
(let ((fp (getf f :filepath))
(added (getf f :lines-added))
(removed (getf f :lines-removed)))
(add-string win (format nil " ~a~@[ +~d~]~@[ -~d~]"
(subseq fp (max 0 (- (length fp) 30)))
(when (> added 0) added)
(when (> removed 0) removed))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y))))
(add-string win " (no changes)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
;; Panel 6: Cost
(incf y 2)
(add-string win "── Cost ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(if session-cost
(progn
(add-string win (format nil " Total: $~,4f" (getf session-cost :total))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y)
(add-string win (format nil " Calls: ~d" (getf session-cost :calls))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)))
(add-string win " (no data)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
;; Panel 7: Protection
(incf y 2)
(add-string win "── Protection ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(if (and block-counts (> (getf block-counts :total) 0))
(let ((by-gate (getf block-counts :by-gate)))
(dolist (entry (subseq by-gate 0 (min (length by-gate) 6)))
(when (< y (1- h))
(add-string win (format nil " ~a: ~d" (car entry) (cdr entry))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :gate-blocked))
(incf y))))
(add-string win " (no blocks)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
(refresh win)
(- y 1)))
(defpackage :passepartout-tui-view-tests
(:use :cl :fiveam :passepartout)
(:export #:tui-view-suite))
(defun view-minibuffer (win)
"Render the bottom-anchored minibuffer panel. Dispatches on :minibuffer-mode."
(case (st :minibuffer-mode)
(:slash-menu (view-slash-menu win))
(:wizard (view-wizard-in-panel win))
(t nil)))
(defvar *slash-commands* nil) ; forward declaration — defined in channel-tui-main
(defun view-slash-menu (win)
"Render the slash-command menu: filter bar, filtered command list, selection highlight."
(clear win)
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(let* ((w (or (width win) 60))
(h (or (height win) 10))
(y 1)
(filter (or (st :minibuffer-filter) ""))
(commands passepartout.channel-tui::*slash-commands*)
(filtered (if (or (null filter) (string= filter ""))
(mapcar (lambda (c) (list :index (position c commands) :cmd c)) commands)
(let ((q (string-downcase filter)) (i 0) (r nil))
(dolist (c commands (nreverse r))
(when (or (search q (string-downcase (getf c :name)))
(search q (string-downcase (or (getf c :desc) ""))))
(push (list :index i :cmd c) r))
(incf i)))))
(sel (or (st :minibuffer-selected-idx) 0))
(max-visible (- h 3)))
;; Header: filter bar
(add-string win (format nil " Commands") :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
(incf y)
(add-string win (format nil " > ~a_" (if (> (length filter) 0) filter "/"))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :input))
(incf y)
;; Command list
(if filtered
(let* ((start (max 0 (- sel (floor max-visible 2))))
(end (min (length filtered) (+ start max-visible)))
(flat-i 0))
(loop for entry across (subseq (coerce filtered 'vector) start end)
for fi from start
for cmd = (getf entry :cmd)
do (let* ((name (getf cmd :name))
(desc (getf cmd :desc))
(selected (= fi sel))
(fg (if selected (theme-color :highlight) (theme-color :agent))))
(when selected
(add-string win (make-string (- w 4) :initial-element #\Space) :y y :x 2 :n (- w 4)
:fgcolor (theme-color :dim) :bgcolor (theme-color :highlight)))
(let ((prefix (if selected " > " " ")))
(add-string win (format nil "~a~a" prefix name) :y y :x 3 :n (min (- w 6) 25) :fgcolor fg)
(when desc
(add-string win (format nil " — ~a" desc) :y y :x 28 :n (min (- w 30) (length desc)) :fgcolor (theme-color :dim))))
(incf y))))
(progn
(add-string win " (no matching commands)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(incf y)))
;; Footer
(add-string win " ↑↓ Navigate Enter Execute Esc Close"
:y (- h 0) :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(refresh win)
(- h 0)))
(defun view-wizard-in-panel (win)
"Render the setup wizard in the bottom-anchored minibuffer panel. Three modes: provider-list, key-entry, cascade-config."
(clear win)
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(let* ((w (or (width win) 70))
(h (or (height win) 14))
(y 1)
(mode (st :wizard-mode))
(error-msg (st :wizard-error))
(selected-idx (st :wizard-selected-idx))
(providers (passepartout.channel-tui::wizard-provider-list))
(configured (st :wizard-providers)))
(add-string win "Setup Wizard" :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
(incf y 2)
(case mode
(:provider-list
(let ((count (/ (length configured) 2)))
(add-string win (format nil "Configure Providers~a"
(if (> count 0) (format nil " — ~d configured" count) ""))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(incf y)
(loop for p in providers
for i from 0
do (let* ((meta (passepartout.channel-tui::wizard-provider-meta p))
(name (car meta))
(key (getf configured p))
(prefix (if (= i selected-idx) "> " " "))
(suffix (if key " ✓" ""))
(color (if (= i selected-idx)
(theme-color :highlight)
(theme-color :dim))))
(add-string win (format nil "~a~a~a" prefix name suffix)
:y y :x 3 :n (- w 6) :fgcolor color)
(incf y)))
(incf y)
(add-string win " Done — configure cascade"
:y y :x 3 :n (- w 6)
:fgcolor (if (>= selected-idx (length providers))
(theme-color :highlight)
(theme-color :dim)))
(when (>= selected-idx (length providers))
(add-string win ">" :y y :x 1 :n 2 :fgcolor (theme-color :highlight))))
(:key-entry
(let* ((provider (st :wizard-current-provider))
(meta (passepartout.channel-tui::wizard-provider-meta provider))
(name (car meta))
(url (cadr meta))
(input (or (st :wizard-input) "")))
(add-string win (format nil "API Key: ~a" name) :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y)
(when url
(add-string win (format nil "Get key at: ~a" url) :y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))
(incf y))
(add-string win "Enter your API key." :y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))
(incf y 2)
(add-string win (format nil "Key: > ~a" input) :y y :x 3 :n (- w 6) :fgcolor (theme-color :input))
(incf y)
(when error-msg
(add-string win (format nil "! ~a" error-msg) :y y :x 3 :n (- w 6) :fgcolor (theme-color :error))
(incf y))
(incf y)
(add-string win "Enter=Save Esc=Back Bksp=Edit Ctrl+U=Clear"
:y (- h 0) :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(return-from view-wizard-in-panel)))
(:cascade-config
(let* ((slot (st :wizard-cascade-slot))
(slot-providers (getf (st :wizard-cascade) slot))
(slot-label (cadr (assoc slot passepartout.channel-tui::*wizard-cascade-labels*)))
(count (/ (length configured) 2)))
(add-string win (format nil "Configure Cascade — ~d provider~:p" count)
:y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(incf y)
(add-string win (or slot-label "Unknown") :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
(incf y)
(let ((shown nil))
(loop for p in providers
for i from 0
do (when (getf configured p)
(let* ((meta (passepartout.channel-tui::wizard-provider-meta p))
(name (car meta))
(in-slot (member p slot-providers))
(prefix (if (= i selected-idx) "> " " "))
(mark (if in-slot " [✓]" " [ ]"))
(color (if (= i selected-idx)
(theme-color :highlight)
(if in-slot (theme-color :gate-passed) (theme-color :dim)))))
(add-string win (format nil "~a~a~a" prefix name mark)
:y y :x 3 :n (- w 6) :fgcolor color)
(incf y)
(push t shown))))
(unless shown
(add-string win " (no providers configured)"
:y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))
(incf y)))
(incf y)
(add-string win (format nil "Cascade: ~{~a~^, ~}"
(or slot-providers '("(none)")))
:y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))))
(when error-msg
(incf y)
(add-string win (format nil "! ~a" error-msg) :y y :x 3 :n (- w 6) :fgcolor (theme-color :error)))
(let ((footer (case mode
(:provider-list "↑↓ Navigate Enter=Select Esc=Back Ctrl+D=Remove")
(:cascade-config "↑↓ Select Enter=Toggle Tab=Next Quadrant Ctrl+S=Save Esc=Back")
(t ""))))
(when footer
(add-string win footer :y (- h 0) :x 2 :n (- w 4) :fgcolor (theme-color :dim))))
(- h 0)))))
#+end_src
* v0.8.0 Tests — Sidebar View + Minibuffer View
#+begin_src lisp
(in-package :passepartout-tui-view-tests)
(test test-theme-hex-string-keys-exist
"v0.8.0: all 27 theme keys are present in *tui-theme*."
(let* ((theme passepartout.channel-tui::*tui-theme*)
(required '(:user :agent :system :input :timestamp :help :error :warning
:connected :disconnected :busy :idle
:gate-passed :gate-blocked :gate-approval :hitl
:tool-running :tool-success :tool-failure :tool-output
:scroll-indicator :border :background
:rule-count :focus-map
:dim :highlight :accent)))
(dolist (key required)
(is (getf theme key) (format nil "~a should be defined" key)))))
(def-suite tui-view-suite :description "TUI view rendering helpers")
(in-suite tui-view-suite)
(test test-theme-presets-count
"v0.8.0: 8 presets defined: dark, light, solarized, gruvbox, nord, tokyonight, catppuccin, monokai."
(let* ((presets passepartout.channel-tui::*tui-theme-presets*)
(names '(:dark :light :solarized :gruvbox :nord :tokyonight :catppuccin :monokai)))
(dolist (name names)
(is (getf presets name) (format nil "~a preset should exist" name)))))
(test test-char-width-ascii
"Contract 5: ASCII characters (< 128) have width 1."
(is (= 1 (passepartout::char-width #\a)))
(is (= 1 (passepartout::char-width #\Space)))
(is (= 1 (passepartout::char-width #\@))))
(test test-minibuffer-init-state-fields
"Contract v0.8.0: init-state includes minibuffer-mode, selected-idx, filter; excludes palette and wizard-visible."
(test test-char-width-tab
"Contract 5: tab character has width 8."
(is (= 8 (passepartout::char-width #\Tab))))
(test test-char-width-cjk
"Contract 5: CJK characters have width 2."
(is (= 2 (passepartout::char-width #\日))))
(test test-char-width-null
"Contract 5: null has width 0."
(is (= 0 (passepartout::char-width #\Nul))))
(test test-markdown-bold
"Contract 7: parse-markdown-spans detects **bold**."
(let ((segments (passepartout::parse-markdown-spans "hello **world**!")))
(is (= 3 (length segments)))))
(test test-markdown-plain
"Contract 7: plain text returns single segment."
(let ((segments (passepartout::parse-markdown-spans "plain")))
(is (= 1 (length segments)))
(is (string= "plain" (caar segments)))))
(test test-markdown-url
"Contract 7: parse-markdown-spans detects URLs."
(let ((segments (passepartout::parse-markdown-spans "see https://example.com for more")))
(is (>= (length segments) 2))
(is (find t segments :key (lambda (s) (getf (cdr s) :url))))))
(test test-markdown-blocks
"Contract 8: parse-markdown-blocks detects code blocks."
(let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
(segs (passepartout::parse-markdown-blocks text)))
(is (= 3 (length segs)))
(let ((code (second segs)))
(is (eq t (getf code :code-block)))
(is (string= "lisp" (getf code :lang)))
(is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
(test test-markdown-blocks-no-close
"Contract 8: unclosed code block returns content."
(let* ((text (format nil "```~%unclosed code"))
(segs (passepartout::parse-markdown-blocks text)))
(is (= 1 (length segs)))
(is (eq t (getf (first segs) :code-block)))))
(test test-syntax-highlight
"Contract 9: syntax-highlight colors Lisp code."
(let ((segs (passepartout::syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
(is (>= (length segs) 3))))
(test test-syntax-highlight-keyword
"Contract 9: syntax-highlight colors keywords."
(let ((segs (passepartout::syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
(is (>= (length segs) 2))
(is (find :keyword segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
(test test-syntax-highlight-function
"Contract 9: syntax-highlight colors function calls."
(let ((segs (passepartout::syntax-highlight "(+ 1 2)" "lisp")))
(is (>= (length segs) 2))
(is (find :function segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
(test test-gate-trace-lines-passed
"Contract 9: gate-trace-lines for passed gate."
(let ((lines (passepartout::gate-trace-lines
'((:gate "path" :result :passed)))))
(is (= 1 (length lines)))
(is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
(test test-gate-trace-lines-blocked
"Contract 9: gate-trace-lines for blocked gate."
(let ((lines (passepartout::gate-trace-lines
'((:gate "shell" :result :blocked :reason "rm")))))
(is (= 1 (length lines)))
(is (search "rm" (caar lines)))))
(test test-gate-trace-lines-approval
"Contract 9: gate-trace-lines for approval gate."
(let ((lines (passepartout::gate-trace-lines
'((:gate "network" :result :approval)))))
(is (= 1 (length lines)))
(is (search "HITL" (caar lines)))))
(test test-init-state-has-collapsed-gates
"Contract v0.7.2: init-state includes :collapsed-gates field."
(passepartout.channel-tui::init-state)
(is (null (passepartout.channel-tui::st :minibuffer-mode)))
(is (= 0 (passepartout.channel-tui::st :minibuffer-selected-idx)))
(is (string= "" (passepartout.channel-tui::st :minibuffer-filter)))
(is (null (getf passepartout.channel-tui::*state* :palette-visible)))
(is (null (getf passepartout.channel-tui::*state* :wizard-visible))))
(test test-slash-commands-entry-count
"Contract v0.8.0: *slash-commands* has at least 19 entries, each with :name, :desc, :action."
(let ((cmds passepartout.channel-tui::*slash-commands*))
(is (>= (length cmds) 19))
(dolist (c cmds)
(is (stringp (getf c :name)))
(is (stringp (getf c :desc)))
(is (functionp (getf c :action))))))
#+end_src
(let ((cg (passepartout.channel-tui::st :collapsed-gates)))
(is (null cg))))
#+END_SRC

View File

@@ -381,13 +381,32 @@ case "$COMMAND" in
echo "Starting daemon first..."
$0 daemon
fi
exec sbcl \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval '(declaim (optimize (debug 3) (speed 0) (safety 3)))' \
--eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :passepartout/tui)' \
--eval '(in-package :passepartout)' \
--eval '(handler-bind ((error (lambda (c) (ignore-errors (with-open-file (f (merge-pathnames ".cache/passepartout/tui-crash.log" (user-homedir-pathname)) :direction :output :if-exists :supersede :if-does-not-exist :create) (format f "CRASH: ~a~%~%" c) (sb-debug:print-backtrace :count 50 :stream f) (finish-output f))) (format t "~%=== TUI CRASH ===~%CRASH: ~a~%" c) (format t "Full backtrace saved to ~~/.cache/passepartout/tui-crash.log~~%") (sleep 3) (finish-output) (uiop:quit 1)))) (passepartout.channel-tui:tui-main))'
# Build TUI load script with proper paths
cat > /tmp/tui-load.lisp << LISPEOF
(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))
(declaim (optimize (debug 3) (speed 0) (safety 3)))
(push (truename "$PASSEPARTOUT_DATA_DIR/") asdf:*central-registry*)
(ql:quickload :cl-tty :silent t)
(ql:quickload :passepartout :silent t)
(let ((dir (pathname (format nil "~a/lisp/" (truename "$PASSEPARTOUT_DATA_DIR")))))
(dolist (f '("channel-tui-state" "channel-tui-view" "channel-tui-main"))
(let* ((src (merge-pathnames (format nil "~a.lisp" f) dir))
(fasl (merge-pathnames (format nil "~a.fasl" f) dir)))
(when (or (not (probe-file fasl))
(< (file-write-date fasl) (file-write-date src)))
(compile-file src :output-file fasl :verbose nil :print nil))
(load fasl :verbose nil :print nil))))
(in-package :passepartout)
(handler-bind ((error (lambda (c) (ignore-errors
(with-open-file (f (merge-pathnames ".cache/passepartout/tui-crash.log" (user-homedir-pathname))
:direction :output :if-exists :supersede :if-does-not-exist :create)
(format f "CRASH: ~a~%~%" c) (sb-debug:print-backtrace :count 50 :stream f) (finish-output f)))
(format t "~%=== TUI CRASH ===~%CRASH: ~a~%" c)
(format t "Full backtrace saved to ~~/.cache/passepartout/tui-crash.log~%")
(sleep 3) (finish-output) (uiop:quit 1))))
(passepartout.channel-tui:tui-main))
LISPEOF
exec sbcl --noinform --load /tmp/tui-load.lisp
;;
gateway)
SUBCMD=$1; PLATFORM=$2; TOKEN=$3

View File

@@ -6,7 +6,7 @@
:description "The Probabilistic-Deterministic Lisp Machine"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
:serial t
:components ((:file "lisp/core-package")
:components ((:file "lisp/core-package")
(:file "lisp/core-skills")
(:file "lisp/core-transport")
(:file "lisp/core-memory")
@@ -16,7 +16,7 @@
(:file "lisp/core-pipeline")))
(defsystem :passepartout/tui
:depends-on (:passepartout :croatoan :usocket :bordeaux-threads)
:depends-on (:passepartout :cl-tty :usocket :bordeaux-threads)
:serial t
:components ((:file "lisp/channel-tui-state")
(:file "lisp/channel-tui-view")