Compare commits
9 Commits
f8d56cdeba
...
feature/v0
| Author | SHA1 | Date | |
|---|---|---|---|
| 60ce9c894c | |||
| 36e7d51fce | |||
| af4d81ec9f | |||
| 79896c5ffd | |||
| 4b60e8c544 | |||
| 885fc3f92e | |||
| 6e69c4a724 | |||
| 761678bbd6 | |||
| 2d18fa4525 |
1
docs/.#ROADMAP.org
Symbolic link
1
docs/.#ROADMAP.org
Symbolic link
@@ -0,0 +1 @@
|
||||
user@amr.1407003:1778162380
|
||||
336
docs/ROADMAP.org
336
docs/ROADMAP.org
@@ -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 4–8 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) | ~$500–1,000 | 8-bit tagged toy processor with Lisp primitives |
|
||||
| Shuttle | Multi-project wafer | ~$10,000–20,000 | Tagged RISC-V core at 100–300MHz |
|
||||
| FPGA | Terasic DE10-Nano / Xilinx KCU105 | ~$200–500 | VexRiscv with custom Lisp extensions, PCIe card form factor |
|
||||
| Industrial | Commercial foundry (5nm) | ~$10M–100M+ | 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
@@ -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 ()
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
33
passepartout
33
passepartout
@@ -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
|
||||
|
||||
@@ -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")
|
||||
|
||||
Reference in New Issue
Block a user