amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

bump passepartout: v0.9.0 Warm TUI Redesign — blank slate

Browse Source 
Complete rewrite of the TUI with warm amber/gold color palette and
clean three-zone layout (chat top, input bottom, status very bottom).

1. Layout restructure: input at y=h-3, hint at y=h-2, status at y=h-1
2. Warm palette: 20-key amber/gold theme, 8 warm presets
3. Readline keybindings: Ctrl+A/E/U/W/K/Y/L/D/F/G in :global keymap
4. Chat messages: user boxes (┌─└─), agent headers, collapsible tools
5. Command palette: Ctrl+P top-centered overlay, warm colors
6. Sidebar: Ctrl+B toggle, right panel with focus/rules/context/MCP
7. Keybindings: :ctrl+x, :?, mouse wheel support
8. Search: existing /search with match highlighting
9. Help overlay: ? shows keybinding and command reference
This commit is contained in:
Amr Gharbeia
2026-05-13 19:13:20 -04:00
parent e27cffa4e0
commit 15d16fd520
7 changed files with 1045 additions and 783 deletions
Download Patch File Download Diff File Expand all files Collapse all files

296
docs/ROADMAP.org
View File

@@ -125,25 +125,139 @@ The croatoan TUI is replaced entirely. cl-tty provides the widget set (box, text
~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.
*** TODO Internal evaluation harness — 10 tasks, regression detection
:PROPERTIES:
:ID: id-v090-eval-harness
:CREATED: [2026-05-08 Fri]
** DONE v0.9.0: Warm TUI Redesign — Blank Slate
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-13 Wed]
:END:
- New skill: ~symbolic-evaluation.org~ → ~symbolic-evaluation.lisp~
- ~deftask~ macro: define an eval task with ~:setup~ (create test environment), ~:prompt~ (what to ask the agent), ~:verify~ (function that checks the output), ~:teardown~ (cleanup)
- ~run-eval-suite~: run all registered tasks, produce score (pass count / total), per-task diagnostics
- Initial 10 tasks: find TODOs, create Org note, search codebase, read file, query memory, list projects, run safe shell command, find definition, set TODO state, summarize session
- Regression mode: run after each version build. Fail CI if score drops.
- Task suite grows with codebase: every bug fix adds a regression task
~200 lines.
The v0.8.0 TUI has correct internal wiring but is unusable — input at the top
instead of the bottom, layout bugs where chat overwrites the status bar, and
Ctrl-key shortcuts silently fail. This version strips the TUI down to a clean
three-zone design with a warm amber/gold color palette inspired by OpenCode and
Gemini CLI. Everything in view/state/main is rewritten; only the daemon protocol
survives.
** v0.9.1: Emacs Development Environment — Secondary Client
*** Visual Mockup
#+begin_example
┌──────────────────────────────────────────────────────────────────┐
│ │
│ ┌─ you ─────────────────────────────────────────────────┐ │
│ │ Can you refactor the dispatcher pipeline? │ │
│ └───────────────────────────────────────────────────────┘ │
│ │
│ ── passepartout ────────────────────────────────────────────── │
│ Sure. The issue is in run-gates — it calls predicates │
│ before checking type levels. Let me fix that. │
│ │
│ ┌─ shell: run tests ──── 0.3s ─────────────────────────┐ │
│ │ ✓ all 12 tests pass │ │
│ └──────────────────────────────────────────────────────┘ │
│ │
│ ────────────────────────────────────────────────────────────── │
│ │
│ > /focus stoa │
│ Ctrl+P palette │ Up/Dn history │ Tab complete │
├──────────────────────────────────────────────────────────────────┤
│ ● Connected stoa Rules:12 Cost:$0.42 14:30 │
└──────────────────────────────────────────────────────────────────┘
#+end_example
*** Three Zones
**** Zone 3 (bottom-most, 1 line): Status Bar (tmux-style)
Warm dark background (~#2A1F1A~), amber foreground (~#D4A574~). Always visible.
Left: ● Connected, project/focus name, rule count. Right: Session cost, clock.
No borders — background color alone defines the zone.
~30 lines.
**** Zone 2 (just above status, 2 lines): Input Area
Line 1 — ~>~ prompt (warm orange ~#FF8C42~), cursor visible. Readline keybindings
(Ctrl+A/E/U/W/K/Y), Up/Down history, Tab complete, Alt+Enter multi-line.
Line 2 — Context-sensitive hint bar (dim amber ~#A08060~):
Normal: Ctrl+P palette | Up/Dn history | Tab complete
Search: Up/Dn navigate | Enter jump | Esc exit
Dialog: Up/Dn select | Enter confirm | Esc dismiss
Slash commands appear as top-centered overlay dialogs.
~60 lines.
**** Zone 1 (scrollable, fills remaining space): Chat Area
User messages: boxed ~┌─ you ─┐~ / ~└─┘~ (bg #3A2A1A, fg #FFB347)
Agent messages: ~-- passepartout --~ header (fg #D4956A), body (fg #E8D5B7)
System: plain text (fg #C8A87C)
Tool calls: collapsible ~┌─ name -- 0.3s --┐~ (running #FF8C42, done #7CCC6C)
Gate traces: ~╎~ indented lines (pass green, block red, approval yellow)
Date separators between time blocks. Streaming inserts char by char.
~120 lines.
*** Warm Color Palette (18 keys, 8 presets)
| Token | Hex | Role |
|-------+-----+------|
| :user-fg | #FFB347 | User message text |
| :user-bg | #3A2A1A | User message background |
| :user-border | #CC8800 | User message box border |
| :agent-header | #D4956A | Agent message header |
| :agent-fg | #E8D5B7 | Agent message body |
| :system | #C8A87C | System notifications |
| :input-prompt | #FF8C42 | > prompt character |
| :input-fg | #E8D5B7 | Input text |
| :hint | #A08060 | Hint bar text |
| :status-bg | #2A1F1A | Status bar background |
| :status-fg | #D4A574 | Status bar text |
| :dot-connected | #7CCC6C | Status dot when connected |
| :dot-disconnected | #E2584A | Status dot when disconnected |
| :error | #E2584A | Error messages |
| :tool-running | #FF8C42 | In-progress tool |
| :tool-done | #7CCC6C | Completed tool |
| :separator | #4A3A2A | Horizontal rules |
| :accent | #FFB347 | Links, highlights |
| :dim | #8B7355 | Metadata, timestamps |
8 presets: amber, gold, terracotta, sepia, nord-warm, monokai-warm,
gruvbox-warm, light-amber.
~80 lines.
*** Build Plan (590 lines total)
| # | Task | Lines | Files |
|---+------+-------+-------|
| 1 | Layout restructure (+status bar) | 100| view.org, main.org |
| 2 | Warm palette | 80 | state.org |
| 3 | Input area (readline keybindings) | 60 | main.org |
| 4 | Chat messages (boxes, headers, tools) | 120 | view.org |
| 5 | Command palette | 50 | main.org, state.org |
| 6 | Sidebar | 60 | view.org, main.org |
| 7 | Keybindings (all Ctrl in :global) | 50 | main.org |
| 8 | Search | 40 | main.org, view.org |
| 9 | Help overlay | 30 | main.org |
*** Keybinding Reference
| Key | Action |
|-----|--------|
| Enter | Send message |
| Alt+Enter | Newline |
| Up/Down | History cycle |
| Tab | Complete command/path |
| Ctrl+P | Command palette |
| Ctrl+B | Toggle sidebar |
| Ctrl+F | Search messages |
| Ctrl+L | Redraw |
| Ctrl+D | Quit prompt |
| Esc | Interrupt/dismiss |
| PageUp/Dn | Scroll chat |
| Ctrl+Q | Quit |
| ? | Help panel |
** v0.10.0: Emacs Development Environment — Secondary Client
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.
@@ -211,7 +325,7 @@ Each command is a thin wrapper around ~passepartout-send~ (the existing TCP brid
Total: ~260 lines elisp, persisting through v2.0.0+.
** v0.10.0: Phase 0 — Type-Level Gates + Core Integrity (~75 lines)
** v0.11.0: Phase 0 — Type-Level Gates + Core Integrity (~75 lines)
:PROPERTIES:
:ID: id-v090-phase0
@@ -239,7 +353,7 @@ Existing FiveAM gate tests continue to pass. New test: signal at type-level 5 ta
This is Contribution 1 from ~notes/passepartout-whitehead.org~. Every type-level rejection emits a structured event that Phase 1 ingests as a fact. ~30 lines implement the seed of the ontology without any new dependencies. ~75 lines total, extends dispatcher, no new skill.
** v0.11.0: Full Markdown Rendering
** v0.12.0: Full Markdown Rendering
:PROPERTIES:
:ID: id-v071-markdown-full
:CREATED: [2026-05-08 Fri]
@@ -253,7 +367,7 @@ Extend the markdown renderer from v0.7.1:
- Syntax highlighting for code blocks: keyword/string/function colors from theme. Regex-based (no parser dependency).
- All markdown features degrade gracefully to plain text on terminals without attribute support. ~100 lines.
** v0.12.0: Phase 0b — Layered Signal Authentication, Layer 1 (~200 lines)
** v0.13.0: Phase 0b — Layered Signal Authentication, Layer 1 (~200 lines)
:PROPERTIES:
:ID: id-v090-phase0b
:CREATED: [2026-05-09 Sat]
@@ -332,7 +446,7 @@ The gate architecture is designed with all four layers from Phase 0b. Adding a l
~200 lines total. Depends on Phase 0 (type-level gates).
** v0.13.0: Tool Execution Visualization
** v0.14.0: Tool Execution Visualization
:PROPERTIES:
:ID: id-v071-tools
:CREATED: [2026-05-08 Fri]
@@ -347,7 +461,7 @@ When the agent invokes a tool:
Uses Croatoan's ~init-pair~ + ~color-pair~ for 256-color backgrounds on tool state regions. ~100 lines.
** v0.14.0: Phase 1 — Minimum Viable Fact Language (~200 lines, new skill)
** v0.15.0: Phase 1 — Minimum Viable Fact Language (~200 lines, new skill)
:PROPERTIES:
:ID: id-v090-phase1
:CREATED: [2026-05-09 Sat]
@@ -433,7 +547,7 @@ The policy table maps entity classes to ~:singular~, ~:dual~, or ~:plural~. Gate
~200 lines. New skill: ~symbolic-facts.org~. Depends on Phase 0b (auth).
** v0.15.0: Mouse Support
** v0.16.0: Mouse Support
:PROPERTIES:
:ID: id-v071-mouse
:CREATED: [2026-05-08 Fri]
@@ -448,7 +562,7 @@ Croatoan supports ncurses mouse mode via ~(setf mouse-enabled-p)~. Enable:
- Click on gate trace line to expand/collapse trace
~40 lines.
** v0.16.0: Phase 1a — Self-Preservation Mechanisms (~120 lines)
** v0.17.0: Phase 1a — Self-Preservation Mechanisms (~120 lines)
:PROPERTIES:
:ID: id-v090-phase1a
:CREATED: [2026-05-09 Sat]
@@ -494,7 +608,7 @@ The watchdog is outside the SBCL image. A dead process cannot restart itself. ~2
~120 lines. Extends existing skills. Depends on Phase 0-1.
** v0.17.0: Cost Display
** v0.18.0: Cost Display
:PROPERTIES:
:ID: id-v071-cost
:CREATED: [2026-05-08 Fri]
@@ -506,7 +620,7 @@ The watchdog is outside the SBCL image. A dead process cannot restart itself. ~2
- Color-coded: green under daily budget, yellow approaching, red exceeding
- Requires token counter infrastructure from v0.5.0. ~50 lines for display; token counting is v0.5.0 infrastructure.
** v0.18.0: Phase 2 — Screamer as Admission Gate (~200 lines, new skill)
** v0.19.0: Phase 2 — Screamer as Admission Gate (~200 lines, new skill)
:PROPERTIES:
:ID: id-v090-phase2
:CREATED: [2026-05-09 Sat]
@@ -554,7 +668,7 @@ This is the function the archivist calls before any LLM-proposed fact enters the
~200 lines. New skill: ~symbolic-screamer.org~. Depends on Phase 1 (triple store). Not an ASDF dependency — degrades gracefully.
** v0.19.0: Session Export
** v0.20.0: Session Export
:PROPERTIES:
:ID: id-v071-export
:CREATED: [2026-05-08 Fri]
@@ -568,7 +682,7 @@ Claude Code has ~/share~ (shareable URL). OpenCode has ~/export~ (Markdown). Her
- ~/export json~ outputs the session as JSON (for programmatic consumption)
~50 lines. Uses existing message vector and ~memory-object-render~ for Org formatting.
** v0.20.0: Phase 3 — Archivist as Fact Proposer (~100 lines, extends existing archivist)
** v0.21.0: Phase 3 — Archivist as Fact Proposer (~100 lines, extends existing archivist)
:PROPERTIES:
:ID: id-v090-phase3
:CREATED: [2026-05-09 Sat]
@@ -619,7 +733,7 @@ This is the safety net: if the LLM produces a bad extraction that passes Screame
~100 lines. Extends existing archivist skill. Depends on Phase 2 (Screamer).
** v0.21.0: Tool Output Spilling
** v0.22.0: Tool Output Spilling
:PROPERTIES:
:ID: id-v081-output-spill
:CREATED: [2026-05-08 Fri]
@@ -632,7 +746,7 @@ Claude Code saves tool results >30KB to ~/.claude/tool-results/ with a 200-line
- The LLM can ~read-file~ the full output if it needs to analyze it
~30 lines in ~core-loop-act.lisp~
** v0.22.0: Phase 4 — Sufficiency Criterion ("The Flip") (~50 lines)
** v0.23.0: Phase 4 — Sufficiency Criterion ("The Flip") (~50 lines)
:PROPERTIES:
:ID: id-v090-phase4
:CREATED: [2026-05-09 Sat]
@@ -686,7 +800,7 @@ Symbolic Index
~50 lines. Extends Phase 3 (archivist).
** v0.23.0: Read-Only Output Caching Within a Turn
** v0.24.0: Read-Only Output Caching Within a Turn
:PROPERTIES:
:ID: id-v081-cache-turn
:CREATED: [2026-05-08 Fri]
@@ -700,7 +814,7 @@ Claude Code caches read-only tool results within a turn. If the agent reads the
- Prevents redundant tool calls when the agent asks the same question twice within a reasoning step
~25 lines in ~programming-tools.lisp~
** v0.24.0: Skin Engine + 10 Presets
** v0.25.0: Skin Engine + 10 Presets
:PROPERTIES:
:ID: id-v072-skin-engine
:CREATED: [2026-05-08 Fri]
@@ -729,7 +843,7 @@ Claude Code caches read-only tool results within a turn. If the agent reads the
Shipped as part of the skin engine release — the engine with 0 presets is unusable. See Skin Engine TODO above for the preset definitions.
** v0.25.0: Phase 5 — VivaceGraph + Merkle DAG + Ontology Versioning (~400 lines, new skill)
** v0.26.0: Phase 5 — VivaceGraph + Merkle DAG + Ontology Versioning (~400 lines, new skill)
:PROPERTIES:
:ID: id-v090-phase5
:CREATED: [2026-05-09 Sat]
@@ -804,7 +918,7 @@ Queries accept an optional ~:ontology-version~ parameter. The default is ~:activ
~400 lines. New skill: ~symbolic-vivacegraph.org~. Depends on Phase 4 (sufficiency). Not an ASDF dependency — degrades to hash-table fallback.
** v0.26.0: Hooks on defskill — Lifecycle Interception
** v0.27.0: Hooks on defskill — Lifecycle Interception
:PROPERTIES:
:ID: id-v082-hooks
:CREATED: [2026-05-08 Fri]
@@ -819,7 +933,7 @@ Passepartout's skills can inject instructions and react to triggers but cannot i
- Hooks run in skill priority order. A ~:deny~ from any hook short-circuits the chain.
~50 lines in ~defskill~ macro + ~core-perceive.lisp~
** v0.27.0: Phase 6 — ACL2 Structural Verification (~200 lines, new skill)
** v0.28.0: Phase 6 — ACL2 Structural Verification (~200 lines, new skill)
:PROPERTIES:
:ID: id-v090-phase6
:CREATED: [2026-05-09 Sat]
@@ -853,7 +967,7 @@ ACL2 does not verify that ~rm -rf / is destructive. That is an empirical claim a
~200 lines. New skill: ~symbolic-acl2.org~. Depends on Phase 5 (VivaceGraph). Not an ASDF dependency — degrades gracefully.
** v0.28.0: Prompt Templates / Output Styles
** v0.29.0: Prompt Templates / Output Styles
:PROPERTIES:
:ID: id-v082-prompt-styles
:CREATED: [2026-05-08 Fri]
@@ -870,7 +984,7 @@ Claude Code has "output styles" (~default~, ~Explanatory~, ~Learning~). Hermes h
- Style changes are immediate (next think() call). Survive restarts via config persistence.
~100 lines (~60 prompt templates + ~40 TUI integration).
** v0.29.0: Skill Auto-Detection — File-Watch Hot-Reload
** v0.30.0: Skill Auto-Detection — File-Watch Hot-Reload
:PROPERTIES:
:ID: id-v082-auto-reload
:CREATED: [2026-05-08 Fri]
@@ -888,7 +1002,7 @@ Passepartout's image-based Lisp model enables hot-reload — redefine a function
- On compile error: keep the old version loaded, log the error, show TUI warning: ~"✗ Skill 'skill-name' failed to compile — old version retained."~
~80 lines in a new ~symbolic-file-watch.org~ skill.
** v0.30.0: Heavy Thinking Skill — Parallel Reasoning + Sequential Deliberation
** v0.31.0: Heavy Thinking Skill — Parallel Reasoning + Sequential Deliberation
:PROPERTIES:
:ID: id-v082-heavy-thinking
:CREATED: [2026-05-08 Fri]
@@ -906,7 +1020,7 @@ The HeavySkill paper (arXiv:2605.02396v1) demonstrates that a two-stage pipeline
- Cost model: 3 parallel × 1 deliberation = 4 API calls for complex tasks (vs 1 normally). ~HEAVY_THINKING_COST_MULTIPLIER~ env var for cost-aware auto-activation
~100 lines as a skill (~60 prompt template + ~40 orchestration in ~symbolic-heavy-thinking.org~).
** v0.31.0: Adaptive Layout (3 Tiers)
** v0.32.0: Adaptive Layout (3 Tiers)
:PROPERTIES:
:ID: id-v073-adaptive-layout
:CREATED: [2026-05-08 Fri]
@@ -918,7 +1032,7 @@ The HeavySkill paper (arXiv:2605.02396v1) demonstrates that a two-stage pipeline
Re-renders on terminal resize (already handled via ~KEY_RESIZE~). Content re-flows — not truncated. The layout remembers per-terminal-size preference. ~80 lines.
** v0.32.0: Spinner Personality
** v0.33.0: Spinner Personality
:PROPERTIES:
:ID: id-v073-spinner
:CREATED: [2026-05-08 Fri]
@@ -934,7 +1048,7 @@ Configurable spinner style per skin:
Stall indication: when no response for 10s, spinner color interpolates from theme color → error red (Claude Code pattern). Reduced motion preference: spinner replaced with slow-pulse ●. ~50 lines.
** v0.33.0: Progress Bar
** v0.34.0: Progress Bar
:PROPERTIES:
:ID: id-v073-progress-bar
:CREATED: [2026-05-08 Fri]
@@ -946,7 +1060,7 @@ For measurable operations (file processing, test runs with known count, batch op
Uses 9 block characters for sub-character precision: ~[' ', '▏', '▎', '▍', '▌', '▋', '▊', '▉', '█']~ (Claude Code pattern). Color-coded by progress: red <25%, yellow 25-75%, green 75%+. ~25 lines.
** v0.34.0: Live Timestamps
** v0.35.0: Live Timestamps
:PROPERTIES:
:ID: id-v073-timestamps
:CREATED: [2026-05-08 Fri]
@@ -958,7 +1072,7 @@ Uses 9 block characters for sub-character precision: ~[' ', '▏', '▎', '▍',
- Timestamps update live (per-minute recalculation, not per-frame)
~40 lines.
** v0.35.0: Context-Sensitive Help
** v0.36.0: Context-Sensitive Help
:PROPERTIES:
:ID: id-v073-help
:CREATED: [2026-05-08 Fri]
@@ -972,7 +1086,7 @@ Press ~?~ to show available actions in current context:
Rendered as a dim help bar at the bottom of the screen (above input). Dismisses on any key or after 5 seconds. ~40 lines.
** v0.36.0: Phase 7 — 10-80-10 Planner (~500 lines, new skill, last phase)
** v0.37.0: Phase 7 — 10-80-10 Planner (~500 lines, new skill, last phase)
:PROPERTIES:
:ID: id-v090-phase7
:CREATED: [2026-05-09 Sat]
@@ -998,7 +1112,7 @@ Screamer returns a viable plan or reports unsolvability with the conflicting con
**** Plan verification
ACL2 proves that the plan contains no deadlocks (two subtasks waiting on each other), no dependency cycles (A depends on B depends on C depends on A), and no safety violations (no plan step requires a gate-blocked operation).
If verification fails, ACL2 identifies the failing subtask and the violated constraint. The planner re-decomposes the problematic branch (the existing ROADMAP's branch pruning, v0.61.0, but symbolically rather than neurally).
If verification fails, ACL2 identifies the failing subtask and the violated constraint. The planner re-decomposes the problematic branch (the existing ROADMAP's branch pruning, v0.62.0, but symbolically rather than neurally).
**** Neuro-symbolic boundary
The LLM handles the I/O boundaries:
@@ -1007,7 +1121,7 @@ The LLM handles the I/O boundaries:
- *Output* (10%): structured plan → natural language response. The verified plan plist is formatted as "I'll refactor the authentication module in 5 steps: 1) Create the OAuth2 client (depends on: nothing, modifies: auth/client.lisp) 2) Add the token store..." Small prompt, formulaic translation, ~150 tokens.
**** TUI visualization
The plan is rendered as an Org headline tree in the TUI, with each subtask as a node showing its terminal state (=todo=, =next-action=, =in-progress=, =done=, =blocked=, =stuck=), its constraints, and its verified properties. This is the same task tree visualization planned for v0.61.0, but with the addition of Screamer constraint annotations and ACL2 verification badges.
The plan is rendered as an Org headline tree in the TUI, with each subtask as a node showing its terminal state (=todo=, =next-action=, =in-progress=, =done=, =blocked=, =stuck=), its constraints, and its verified properties. This is the same task tree visualization planned for v0.62.0, but with the addition of Screamer constraint annotations and ACL2 verification badges.
*** Verification — ~6 FiveAM tests
1. ~test-goal-plist-from-natural-language~ — natural language input produces correct structured goal plist (LLM-dependent but formulaic; tested with deterministic mock).
@@ -1019,7 +1133,7 @@ The plan is rendered as an Org headline tree in the TUI, with each subtask as a
~500 lines. New skill: ~symbolic-planner.org~. Depends on Phase 6 (ACL2) + all prior phases.
** v0.36.1: Phase 8+ — Semantic Wikipedia Integration (TBD lines, optional acceleration)
** v0.37.1: Phase 8+ — Semantic Wikipedia Integration (TBD lines, optional acceleration)
:PROPERTIES:
:ID: id-v090-phase8
:CREATED: [2026-05-10 Sun]
@@ -1046,7 +1160,7 @@ How much Wikidata is the right amount? Loading entities referenced in the memex
TBD lines. New skill. Depends on Phase 5 (VivaceGraph).
** v0.37.0: Priority-Queue Signal Processing
** v0.38.0: Priority-Queue Signal Processing
:PROPERTIES:
:ID: id-v090-priority-queue
@@ -1066,7 +1180,7 @@ Replace the linear ~process-signal~ call chain with a priority-ordered signal qu
~80 lines in ~core-pipeline.lisp~ + ~30 lines TUI.
** v0.38.0: MVCC Memory Concurrency
** v0.39.0: MVCC Memory Concurrency
:PROPERTIES:
:ID: id-v090-mvcc
:CREATED: [2026-05-08 Fri]
@@ -1081,7 +1195,7 @@ Replace the linear ~process-signal~ call chain with a priority-ordered signal qu
~60 lines in ~core-memory.lisp~.
** v0.39.0: Structured Output Enforcement
** v0.40.0: Structured Output Enforcement
:PROPERTIES:
:ID: id-v090-structured-output
:CREATED: [2026-05-08 Fri]
@@ -1095,7 +1209,7 @@ Replace the linear ~process-signal~ call chain with a priority-ordered signal qu
~40 lines in ~core-reason.lisp~.
** v0.40.0: Doom-Loop Detection
** v0.41.0: Doom-Loop Detection
:PROPERTIES:
:ID: id-v090-doom-loop
@@ -1110,7 +1224,7 @@ OpenCode detects 3 consecutive identical tool calls and prompts the user. Withou
- Resets on any different tool call or successful output
~15 lines in ~core-loop-act.lisp~
** v0.41.0: Busy-Mode — Queue on Interrupt
** v0.42.0: Busy-Mode — Queue on Interrupt
:PROPERTIES:
:ID: id-v090-busy-mode
@@ -1125,7 +1239,7 @@ When the agent is processing a turn and the user types a message, the current be
- The priority queue (above) naturally supports this — user input queued during a turn has higher priority than heartbeats, lower than the active turn
~20 lines in ~core-pipeline.lisp~
** v0.42.0: CLI / Non-Interactive Mode
** v0.43.0: CLI / Non-Interactive Mode
:PROPERTIES:
:ID: id-v090-cli
@@ -1141,7 +1255,7 @@ Claude Code supports ~claude -p "fix the failing test" --print~. Hermes has ~her
- Uses the existing wire protocol — no new protocol, just a CLI wrapper around the framed TCP message format
~80 lines in ~passepartout~ bash script + ~50 lines daemon handler.
** v0.43.0: Provider Health Tracking
** v0.44.0: Provider Health Tracking
:PROPERTIES:
:ID: id-v090-provider-health
@@ -1157,7 +1271,7 @@ Claude Code supports ~claude -p "fix the failing test" --print~. Hermes has ~her
- Telemetry: provider health data feeds the session telemetry system
~60 lines in ~neuro-provider.lisp~ + ~30 lines TUI.
** v0.44.0: Cost-Based Provider Routing
** v0.45.0: Cost-Based Provider Routing
:PROPERTIES:
:ID: id-v090-cost-routing
@@ -1172,7 +1286,7 @@ Claude Code supports ~claude -p "fix the failing test" --print~. Hermes has ~her
- ~/routing~ TUI command: displays current cascade order with scores and reasons
~40 lines in ~core-reason.lisp~
** v0.45.0: Intelligent Provider Fallback — Per-Task-Type Routing
** v0.46.0: Intelligent Provider Fallback — Per-Task-Type Routing
:PROPERTIES:
:ID: id-v090-intelligent-fallback
@@ -1188,7 +1302,7 @@ Current fallback is "try the next provider." But different providers excel at di
- Bootstrap from defaults: GPT-4/Claude for reasoning, DeepSeek for code, Groq for chat, local Ollama for reflex
~60 lines in ~neuro-router.lisp~
** v0.46.0: Autonomous Certification Badge
** v0.47.0: Autonomous Certification Badge
:PROPERTIES:
:ID: id-v090-certification
@@ -1204,7 +1318,7 @@ After N HITL approvals of the same pattern, the dispatcher auto-approves it. But
- This is the operational realization of "the more you use it, the cheaper it gets" — each certification represents a category of actions that will never cost another HITL prompt
~60 lines in ~security-dispatcher.lisp~ + sidebar rendering reuse.
** v0.47.0: Certification Progress Bar
** v0.48.0: Certification Progress Bar
:PROPERTIES:
:ID: id-v090-cert-progress
@@ -1218,7 +1332,7 @@ The certification badge grants permanent auto-approval. Users need to see this h
- Certification velocity: ~"+2 certified this week"~ trend indicator in sidebar
~30 lines on top of existing sidebar rendering.
** v0.48.0: Update Mechanism + Migrations
** v0.49.0: Update Mechanism + Migrations
:PROPERTIES:
:ID: id-v090-update
@@ -1231,10 +1345,10 @@ No update mechanism exists. Users must manually ~git pull~ and re-run ~passepart
- ~passepartout update~ (git-based) — ~git fetch --tags && git checkout v0.5.1~, incremental tangle (only org files changed since previous tag, via ~git diff --name-only v0.5.0..v0.5.1 -- org/*.org~), recompile changed lisp files, restart daemon
- Migration hooks: ~~/memex/system/migrations/~ — ordered Lisp scripts run after tangle, before daemon restart. ~migrate-v051.lisp~ upgrades memory format, config schema, package names. Tracked by ~*migration-version*~ in ~~/.config/passepartout/version.lisp~
- Post-update verification: run internal eval suite, verify skill count ≥ 10, smoke test daemon port 9105. On failure: ~passepartout update --rollback~ → ~git checkout v0.5.0~ → re-tangle → restart
- Binary update path (when v0.63.0 ships): download binary from GitHub Releases, verify SHA-256, replace, restart
- Binary update path (when v0.64.0 ships): download binary from GitHub Releases, verify SHA-256, replace, restart
~80 lines bash + ~50 lines Lisp.
** v0.49.0: Self-Configuration — Agent Proposes and Applies Config Changes
** v0.50.0: Self-Configuration — Agent Proposes and Applies Config Changes
:PROPERTIES:
:ID: id-v090-self-config
@@ -1251,11 +1365,11 @@ Passepartout's config is text files (`.env`, `.lisp`) — the same format the ag
Three tiers of self-configuration:
1. **Config Query** (v0.7.2) — "What providers do I have?" → answered from system prompt CONFIG section. Already implemented.
2. **Config Suggest** (v0.49.0) — "Should I use a cheaper model?" → agent analyzes telemetry, proposes specific config change with estimated savings. User decides.
3. **Config Apply** (v0.49.0) — "Add @credentials to privacy tags" → agent proposes change → HITL review → writes `.env` → daemon reloads → change takes effect within one think() cycle.
4. **Config Optimize** (v0.49.0) — "Make yourself cheaper" → agent analyzes cost patterns across all sessions, proposes multi-key optimization. User approves full batch.
2. **Config Suggest** (v0.50.0) — "Should I use a cheaper model?" → agent analyzes telemetry, proposes specific config change with estimated savings. User decides.
3. **Config Apply** (v0.50.0) — "Add @credentials to privacy tags" → agent proposes change → HITL review → writes `.env` → daemon reloads → change takes effect within one think() cycle.
4. **Config Optimize** (v0.50.0) — "Make yourself cheaper" → agent analyzes cost patterns across all sessions, proposes multi-key optimization. User approves full batch.
** v0.50.0: Self-Diagnosis Coach — ~/coach~ Command
** v0.51.0: Self-Diagnosis Coach — ~/coach~ Command
:PROPERTIES:
:ID: id-v090-coach
@@ -1267,7 +1381,7 @@ Telemetry data plus the agent's self-knowledge enables coaching: the agent detec
- ~/coach~ — analyzes telemetry from the last N sessions, produces a coaching report with 3-5 actionable tips. Coaching is opt-in (privacy-respecting — no data leaves the machine).
~50 lines in telemetry skill + ~30 lines TUI rendering.
** v0.51.0: Failure Attribution — Tag Task Failures with Probable Component
** v0.52.0: Failure Attribution — Tag Task Failures with Probable Component
:PROPERTIES:
:ID: id-v090-failure-attribution
@@ -1278,10 +1392,10 @@ AHE (arXiv:2604.25850v2) shows that evolution loops work when failures are attri
- In telemetry skill: when a session ends with a task failure, classify as: ~:tool-failure~, ~:gate-overblock~, ~:gate-underblock~, ~:reasoning-error~, ~:context-overflow~, ~:timeout~
- Classification is deterministic: if last action was blocked by dispatcher → gate-overblock. If last action was a tool error → tool-failure. If last action was a successful tool call but wrong output → reasoning-error.
- Feeds the Skill Creator (v0.57.0) — the agent knows *which* component to fix, not just *that* something went wrong
- Feeds the Skill Creator (v0.58.0) — the agent knows *which* component to fix, not just *that* something went wrong
~20 lines in telemetry skill.
** v0.52.0: MCP Native Client
** v0.53.0: MCP Native Client
:PROPERTIES:
:ID: id-v100-mcp
@@ -1296,7 +1410,7 @@ AHE (arXiv:2604.25850v2) shows that evolution loops work when failures are attri
~200 lines as a new skill ~mcp-client.org~.
** v0.53.0: Web Search + Web Fetch Tools
** v0.54.0: Web Search + Web Fetch Tools
:PROPERTIES:
:ID: id-v100-web
:CREATED: [2026-05-08 Fri]
@@ -1309,7 +1423,7 @@ Claude Code has ~WebSearchTool~ + ~WebFetchTool~. Hermes has ~firecrawl-py~ + ~e
- Both register via ~def-cognitive-tool~ as read-only tools (auto-approve via v0.7.2 safe-tool allowlist)
~150 lines as a new skill ~programming-web.org~. No external Python/Node.js process.
** v0.54.0: LSP Integration
** v0.55.0: LSP Integration
:PROPERTIES:
:ID: id-v100-lsp
@@ -1325,7 +1439,7 @@ Claude Code uses LSP for code intelligence — find definitions, find references
- LSP servers installed by the user (e.g., ~npm install -g typescript-language-server~). Passepartout auto-discovers installed servers via PATH.
~200 lines. Register as read-only cognitive tools. No daemon protocol changes — LSP is a background process, not a rendering concern.
** v0.55.0: ~debug-inspect~ Cognitive Tool
** v0.56.0: ~debug-inspect~ Cognitive Tool
:PROPERTIES:
:ID: id-v100-debug-inspect
@@ -1340,7 +1454,7 @@ Lisp enables live state inspection that no TypeScript/Python agent can match. Cl
- The agent can introspect its own state to answer meta-questions: "How many objects are in memory?" "What skills are loaded?" "What was the last HITL decision?"
~30 lines in ~programming-repl.lisp~ (extends existing repl-eval with safety guard).
** v0.56.0: Session Transcripts — ~/memex/system/sessions/~
** v0.57.0: Session Transcripts — ~/memex/system/sessions/~
:PROPERTIES:
:ID: id-v100-transcripts
@@ -1357,7 +1471,7 @@ Passepartout has no session persistence beyond Merkle tree snapshots. Chat histo
- Survives daemon restarts. Resume via ~/resume <date-title>~ (existing session resume from v0.7.2)
~80 lines in ~core-transport.lisp~ (append on message send) + reuse existing Org rendering.
** v0.57.0: Auto-Memory Extraction — Learnings from Sessions
** v0.58.0: Auto-Memory Extraction — Learnings from Sessions
:PROPERTIES:
:ID: id-v100-auto-memory
@@ -1373,7 +1487,7 @@ Claude Code's ~extractMemories~ runs at the end of each query loop, scanning the
- Opt-out via ~AUTO_MEMORY=false~ env var. Extraction frequency capped at one per minute to prevent runaway API costs.
~80 lines in ~core-reason.lisp~ + reuse session transcript for context.
** v0.58.0: Universal Cross-Project Org Query
** v0.59.0: Universal Cross-Project Org Query
:PROPERTIES:
:ID: id-v100-org-query
@@ -1388,7 +1502,7 @@ Passepartout's entire memex is Org — one format for memory, tasks, documents,
- ~(org-query :limit 20 :sort :priority)~ — sorted, capped results.
~150 lines in ~programming-org.lisp~ (extends existing Org manipulation primitives).
** v0.59.0: Skill Creator — LLM-Drafted, Verified Skills
** v0.60.0: Skill Creator — LLM-Drafted, Verified Skills
:PROPERTIES:
:ID: id-v110-skill-creator
@@ -1401,7 +1515,7 @@ Passepartout's entire memex is Org — one format for memory, tasks, documents,
- Skills are the primary extension mechanism for users. The Skill Creator makes skill authoring accessible to non-Lisp-programmers: describe what you want in English, the LLM drafts the Org file, the system verifies it, and the skill is live.
~150 lines as a new skill ~symbolic-skill-creator.org~.
** v0.60.0: Change Manifest — Skills Ship with Falsifiable Predictions
** v0.61.0: Change Manifest — Skills Ship with Falsifiable Predictions
:PROPERTIES:
:ID: id-v110-change-manifest
@@ -1416,7 +1530,7 @@ AHE (arXiv:2604.25850v2) shows that harness edits work better when each edit shi
- The change manifest persists in the skill's Org file — every skill carries its own evidence ledger.
~40 lines in Skill Creator + telemetry integration.
** v0.61.0: Long-Horizon Planning (Task Tree DAG)
** v0.62.0: Long-Horizon Planning (Task Tree DAG)
:PROPERTIES:
:ID: id-v110-planning
@@ -1431,7 +1545,7 @@ AHE (arXiv:2604.25850v2) shows that harness edits work better when each edit shi
- TUI task tree visualization: a collapsible Org headline tree rendered in the chat area. Each node shows its terminal state with a colored indicator (~○~ todo, ~▶~ next-action, ~◉~ in-progress, ~✓~ done, ~✗~ blocked, ~⏸~ stuck). Nodes expand/collapse on Enter. The tree updates in real time as the agent progresses through subtasks.
~200 lines.
** v0.62.0: Tier Classifier Fix
** v0.63.0: Tier Classifier Fix
:PROPERTIES:
:ID: id-v110-tier-fix
@@ -1444,7 +1558,7 @@ AHE (arXiv:2604.25850v2) shows that harness edits work better when each edit shi
- The classifier should be a skill, not core infrastructure — reloadable and replaceable without restart.
~40 lines.
** v0.63.0: SWE-Bench Harness
** v0.64.0: SWE-Bench Harness
:PROPERTIES:
:ID: id-v120-swebench
@@ -1457,7 +1571,7 @@ AHE (arXiv:2604.25850v2) shows that harness edits work better when each edit shi
- Target: competitive score with Claude Code and OpenClaw on SWE-bench-verified by v1.0.0.
~200 lines.
** v0.64.0: Computer Use / Vision
** v0.65.0: Computer Use / Vision
:PROPERTIES:
:ID: id-v120-vision
@@ -1470,7 +1584,7 @@ AHE (arXiv:2604.25850v2) shows that harness edits work better when each edit shi
- Use case: "open Firefox, search for the Passepartout GitHub repo, and star it."
~100 lines.
** v0.65.0: Telemetry / Observability
** v0.66.0: Telemetry / Observability
:PROPERTIES:
:ID: id-v120-telemetry
@@ -1484,7 +1598,7 @@ AHE (arXiv:2604.25850v2) shows that harness edits work better when each edit shi
- Feeds the evaluation harness (SWE-bench trajectory data comes from the same telemetry system)
~200 lines as a new skill ~symbolic-telemetry.org~. No daemon protocol changes.
** v0.66.0: Consensus Loop
** v0.67.0: Consensus Loop
:PROPERTIES:
:ID: id-v130-consensus
@@ -1497,7 +1611,7 @@ AHE (arXiv:2604.25850v2) shows that harness edits work better when each edit shi
- TUI consensus display: collapsible region listing each provider, its model, its proposal, and its confidence score. ~✓ 3/3 providers agree~ in green; ~✗ 2/3 agree~ in yellow.
~80 lines.
** v0.67.0: GTD Integration
** v0.68.0: GTD Integration
:PROPERTIES:
:ID: id-v130-gtd
@@ -1510,7 +1624,7 @@ AHE (arXiv:2604.25850v2) shows that harness edits work better when each edit shi
- TUI agenda view: ~/agenda~ command renders Org-agenda as formatted scrollable region within the chat area.
~150 lines.
** v0.68.0: Deep Emacs Integration
** v0.69.0: Deep Emacs Integration
:PROPERTIES:
:ID: id-v130-emacs
@@ -1523,7 +1637,7 @@ AHE (arXiv:2604.25850v2) shows that harness edits work better when each edit shi
- Refile and archive: agent refiles headlines between Org files and archives completed items.
~300 lines.
** v0.69.0: Save-Lisp-and-Die Binary
** v0.70.0: Save-Lisp-and-Die Binary
:PROPERTIES:
:ID: id-v140-save-lisp
@@ -1538,7 +1652,7 @@ AHE (arXiv:2604.25850v2) shows that harness edits work better when each edit shi
- Add FiveAM test: the deterministic path succeeds on a system with all dependencies pre-installed; the LLM-assisted path correctly classifies 10 common package-manager error messages.
~200 lines Lisp + build configuration.
** v0.70.0: Channels + Providers — Match OpenClaw on Demand
** v0.71.0: Channels + Providers — Match OpenClaw on Demand
:PROPERTIES:
:ID: id-v100-channels
@@ -1553,34 +1667,34 @@ The daemon protocol is client-agnostic hex-framed plists over TCP. Every new cha
No separate releases. Done when needed, shipped when ready.
** v0.71.0: Lish Shell
** v0.72.0: Lish Shell
- plist-returning commands: ~(ls :path "~/memex/projects/")~ → structured result
- Pipe as function composition: ~(pipe (ls ...) (filter :state 'TODO))~
- Org-buffer output: shell output rendered as Org headlines
- External bash compatibility: ~(bash "npm run build")~ → plist with exit code, stdout, stderr
~500 lines CL. Useful immediately for the agent.
** v0.72.0: Buffer-as-CLOS Prototype
** v0.73.0: Buffer-as-CLOS Prototype
- buffer class: source (file path or Org AST), content, cursor, marks, overlays
- Key editing primitives: insert, delete, move, search, replace
- Org-AST-backed: editing mutates the AST, text rendering is a view
~300 lines CL. No display dependency.
** v0.73.0: EQL5 Feasibility
** v0.74.0: EQL5 Feasibility
- Add EQL5 to Quicklisp dependencies (optional, like croatoan)
- Compile and verify on Linux (primary target)
- Single QML window: "Passepartout" title, 800x600, dark background
- Verify event loop integration with SBCL threads
~100 lines QML + build config.
** v0.74.0: EQL5 TCP Client
** v0.75.0: EQL5 TCP Client
- QML window with terminal widget, input area, status bar
- Connects to daemon via existing framed TCP protocol
- Renders agent responses, gate trace, sidebar panels as QML components
- Lives alongside croatoan TUI (two clients, one daemon)
~300 lines QML + ~200 lines CL.
** v0.75.0: Minibuffer Prototype
** v0.76.0: Minibuffer Prototype
- Universal command line at bottom of Qt window
- /chat /edit /shell /eval dispatch
- Goes through same gate stack as agent actions
@@ -1592,7 +1706,7 @@ v1.0.0 is where the agent achieves symbolic-first reasoning in the 10-80-10 arch
Hallucination becomes structurally impossible because the symbolic engine will not accept a fact that contradicts its knowledge graph. Safety becomes provable because ACL2 can prove properties about the system's behavior. Self-improvement becomes stable because the agent modifies skills that are then verified before execution.
The system is benchmarked against SWE-bench (competitive score with Claude Code and OpenClaw), verified under concurrent load (MVCC from v0.38.0), and validated by the eval harness (v0.9.0). The 10-80-10 planner operates on a mature symbolic index seeded from months of gate outcomes, Screamer deductions, LLM-proposed facts with provenance, and human-authored facts.
The system is benchmarked against SWE-bench (competitive score with Claude Code and OpenClaw), verified under concurrent load (MVCC from v0.39.0), and validated by the eval harness (v0.9.0). The 10-80-10 planner operates on a mature symbolic index seeded from months of gate outcomes, Screamer deductions, LLM-proposed facts with provenance, and human-authored facts.
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.

273
lisp/channel-tui-main.lisp
View File

@@ -82,54 +82,7 @@
(add-msg :system (format nil "Press Tab to open ~a" url))
(setf (st :dirty) (list t t nil)))
nil))))
;; v0.7.0: Ctrl key bindings
((eql ch 21) ; Ctrl+U — clear line
(setf (st :input-buffer) nil)
(setf (st :dirty) (list nil nil t)))
((eql ch 23) ; Ctrl+W — delete word backward
(let ((buf (st :input-buffer)))
(loop while (and buf (char= (first buf) #\Space)) do (pop buf))
(loop while (and buf (char/= (first buf) #\Space)) do (pop buf))
(setf (st :input-buffer) buf)
(setf (st :dirty) (list nil nil t))))
((eql ch 1) ; Ctrl+A — home
(setf (st :cursor-pos) 0))
((eql ch 5) ; Ctrl+E — end
(setf (st :cursor-pos) (length (st :input-buffer))))
((eql ch 12) ; Ctrl+L — redraw
(setf (st :dirty) (list t t t)))
((eql ch 4) ; Ctrl+D — quit on empty
(when (or (null (st :input-buffer)) (string= "" (input-string)))
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit.")))
((eql ch 6) ; v0.7.2 Ctrl+F — message search
(add-msg :system "Use /search <query> to find messages"))
((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse
(let ((gate-idx nil))
(loop for i from (1- (length (st :messages))) downto 0
for m = (aref (st :messages) i)
when (and (getf m :gate-trace) (listp (getf m :gate-trace)))
do (setf gate-idx i) (loop-finish))
(if gate-idx
(let ((cg (st :collapsed-gates)))
(if (member gate-idx cg)
(setf (st :collapsed-gates) (remove gate-idx cg))
(push gate-idx (st :collapsed-gates)))
(add-msg :system (format nil "Gate trace ~a for msg ~a"
(if (member gate-idx (st :collapsed-gates)) "hidden" "shown")
gate-idx))
(setf (st :dirty) (list nil t nil)))
(add-msg :system "No gate trace to toggle"))))
((eql ch 24) ; Ctrl+X prefix
(setf (st :pending-ctrl-x) t))
((and (st :pending-ctrl-x) (eql ch 5)) ; Ctrl+X+E — editor
(setf (st :pending-ctrl-x) nil)
(add-msg :system "Opening $EDITOR... save and exit to return.")
(setf (st :dirty) (list t t nil)))
((and (st :pending-ctrl-x) (not (eql ch 5))) ; cancel Ctrl+X
(setf (st :pending-ctrl-x) nil)
(on-key ch)
(return-from on-key nil))
;; Enter
;; Enter
((or (eq ch :enter) (eql ch 13) (eql ch 10) (eql ch 343)
(eql ch #\Newline) (eql ch #\Return))
;; Multi-line: if buffer ends with \, strip it and insert newline
@@ -387,19 +340,19 @@
(add-msg :system "Ctrl+G Toggle gate trace"))
;; /theme command
((string-equal text "/theme")
(add-msg :system (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a"
(add-msg :system (format nil "Theme: ~a — user-fg=~a agent-fg=~a system=~a input-fg=~a"
*tui-theme-current-name*
(getf *tui-theme* :user)
(getf *tui-theme* :agent)
(getf *tui-theme* :user-fg)
(getf *tui-theme* :agent-fg)
(getf *tui-theme* :system)
(getf *tui-theme* :input)))
(add-msg :system "Presets: /theme dark | light | solarized | gruvbox"))
(getf *tui-theme* :input-fg)))
(add-msg :system "Presets: /theme amber | gold | terracotta | sepia | nord-warm | monokai-warm | gruvbox-warm | light-amber"))
((and (>= (length text) 7)
(string-equal (subseq text 0 7) "/theme "))
(let ((name (string-trim '(#\Space) (subseq text 7))))
(if (theme-switch name)
(add-msg :system (format nil "Theme switched to ~a" name))
(add-msg :system (format nil "Unknown theme '~a'. Try: dark light solarized gruvbox" name)))))
(if (theme-switch name)
(add-msg :system (format nil "Theme switched to ~a" name))
(add-msg :system (format nil "Unknown theme '~a'. Try: amber gold terracotta sepia nord-warm monokai-warm gruvbox-warm light-amber" name)))))
;; /eval command
((and (>= (length text) 6)
(string-equal (subseq text 0 6) "/eval "))
@@ -485,11 +438,11 @@
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list)))
(setf (st :dirty) (list nil nil t)))))
;; /theme subcommand
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
(let* ((partial (string-trim '(#\Space) (subseq text 7)))
(names '("dark" "light" "solarized" "gruvbox"))
(match (if (string= partial "") (first names)
(find partial names :test #'string-equal))))
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
(let* ((partial (string-trim '(#\Space) (subseq text 7)))
(names '("amber" "gold" "terracotta" "sepia" "nord-warm" "monokai-warm" "gruvbox-warm" "light-amber"))
(match (if (string= partial "") (first names)
(find partial names :test #'string-equal))))
(when match
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list)))
(setf (st :dirty) (list nil nil t)))))
@@ -595,15 +548,15 @@
;; v0.8.0 — command palette for daemon commands (Ctrl+P)
(defun command-palette-show-commands ()
(let* ((on-select (lambda (opt)
(let ((cmd (getf opt :value)))
(pop (st :dialog-stack))
(setf (st :command-palette-active) nil)
(add-msg :system (format nil "Dispatching: ~s" cmd))
(send-daemon (list :type :event :payload cmd))
(setf (st :busy) t)
(setf (st :dirty) (list t t nil)))))
(sel (cl-tty.select:make-select :options *daemon-commands* :on-select on-select))
(let* ((on-select (lambda (cmd)
(pop (st :dialog-stack))
(setf (st :command-palette-active) nil)
(let ((action (getf cmd :value)))
(send-daemon (list :type :event :payload action))
(add-msg :system (format nil "Sent: ~a" action)))
(setf (st :dirty) (list t t nil))))
(sel (cl-tty.select:make-select :options *daemon-commands*
:on-select on-select))
(dlg (make-instance 'cl-tty.dialog:dialog
:title "Command Palette"
:content sel)))
@@ -819,7 +772,69 @@
(setf (st :dirty) (list nil t nil))))
(:npage (lambda (e) (declare (ignore e))
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10)))
(setf (st :dirty) (list nil t nil))))))
(setf (st :dirty) (list nil t nil))))
;; v0.9.0 — Readline keybindings
(:ctrl+a (lambda (e) (declare (ignore e))
(setf (st :cursor-pos) 0)))
(:ctrl+e (lambda (e) (declare (ignore e))
(setf (st :cursor-pos) (length (st :input-buffer)))))
(:ctrl+u (lambda (e) (declare (ignore e))
(setf (st :input-buffer) nil)
(setf (st :cursor-pos) 0)
(setf (st :dirty) (list nil nil t))))
(:ctrl+w (lambda (e) (declare (ignore e))
(let ((buf (st :input-buffer)))
(loop while (and buf (char= (first buf) #\Space)) do (pop buf))
(loop while (and buf (char/= (first buf) #\Space)) do (pop buf))
(setf (st :input-buffer) buf)
(setf (st :dirty) (list nil nil t)))))
(:ctrl+k (lambda (e) (declare (ignore e))
(let* ((s (input-string))
(pos (or (st :cursor-pos) 0))
(killed (subseq s pos)))
(setf (st :kill-ring) killed)
(setf (st :input-buffer) (reverse (coerce (subseq s 0 pos) 'list)))
(setf (st :dirty) (list nil nil t)))))
(:ctrl+y (lambda (e) (declare (ignore e))
(let ((killed (st :kill-ring)))
(when killed
(dolist (ch (reverse (coerce killed 'list)))
(push ch (st :input-buffer)))
(setf (st :cursor-pos) (length (st :input-buffer)))
(setf (st :dirty) (list nil nil t))))))
(:ctrl+l (lambda (e) (declare (ignore e))
(setf (st :dirty) (list t t t))))
(:ctrl+d (lambda (e) (declare (ignore e))
(when (or (null (st :input-buffer)) (string= "" (input-string)))
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))))
(:ctrl+f (lambda (e) (declare (ignore e))
(add-msg :system "Use /search <query> to find messages")))
(:ctrl+g (lambda (e) (declare (ignore e))
(let ((gate-idx nil))
(loop for i from (1- (length (st :messages))) downto 0
for m = (aref (st :messages) i)
when (and (getf m :gate-trace) (listp (getf m :gate-trace)))
do (setf gate-idx i) (loop-finish))
(if gate-idx
(let ((cg (st :collapsed-gates)))
(if (member gate-idx cg)
(setf (st :collapsed-gates) (remove gate-idx cg))
(push gate-idx (st :collapsed-gates)))
(add-msg :system (format nil "Gate trace ~a for msg ~a"
(if (member gate-idx (st :collapsed-gates)) "hidden" "shown")
gate-idx))
(setf (st :dirty) (list nil t nil)))
(add-msg :system "No gate trace to toggle")))))
(:alt+enter (lambda (e) (declare (ignore e))
(push #\Newline (st :input-buffer))
(setf (st :dirty) (list nil nil t))))
;; v0.9.0 — Ctrl+X prefix + help
(:ctrl+x (lambda (e) (declare (ignore e))
(setf (st :pending-ctrl-x) t)))
(:? (lambda (e) (declare (ignore e))
(add-msg :system "Keybindings: Ctrl+P palette | Ctrl+B sidebar | Ctrl+F search | Ctrl+L redraw | Ctrl+D quit | Ctrl+Q quit | PageUp/Dn scroll | Esc interrupt | Tab complete | Up/Dn history")
(add-msg :system "Commands: /eval <expr> | /undo | /redo | /why | /identity | /tags | /audit | /search | /context | /focus | /scope | /unfocus | /theme | /reconnect | /help")
(setf (st :dirty) (list t t nil))))))
;; v0.8.0 — Prompt/local keymap (for when input is active)
(eval-when (:load-toplevel :execute)
@@ -906,44 +921,59 @@
(let ((f (cl-tty.select:select-filter sel)))
(when (> (length f) 0)
(setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f)))))))))
((cl-tty.input:dispatch-key-event data)
nil)
(t (on-key ch)))))))
;; v0.9.0 — Mouse wheel support
((cl-tty.input:mouse-event-p data)
(let ((btn (cl-tty.input:mouse-event-button data)))
(cond
((eql btn :scroll-up)
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 3))))
(setf (st :dirty) (list nil t nil)))
((eql btn :scroll-down)
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 3)))
(setf (st :dirty) (list nil t nil))))))
((cl-tty.input:dispatch-key-event data)
nil)
(t (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
(cl-tty.backend:backend-clear be)
(redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
;; Draw separator line above input
(cl-tty.backend:draw-text be 0 (- h 4) (make-string w :initial-element #\─)
(theme-color :separator) nil)
(rotatef prev-fb curr-fb))
(let ((ds (st :dialog-stack)))
(when ds
(let* ((dlg (car ds))
(sel (cl-tty.dialog:dialog-content dlg))
(filtered (cl-tty.select:select-filtered-options sel))
(sel-idx (cl-tty.select:select-selected-index sel))
(cnt (length filtered))
(dw 60) (dh (min 20 (+ 4 cnt)))
(mx (floor (- w dw) 2))
(my (floor (- h dh) 2)))
(dotimes (row h)
(cl-tty.backend:draw-rect be 0 row w 1 :bg :bright-black))
(cl-tty.backend:draw-border be mx my dw dh :style :single
:title (cl-tty.dialog:dialog-title dlg))
(let ((y-off 1))
(dolist (item filtered)
(let* ((display-idx (first item))
(option (third item))
(title (getf option :title))
(cat (getf option :category))
(sel-p (eql display-idx sel-idx))
(text (if cat (format nil " ~a" title)
(format nil " ~:[ ~;▸~] ~a" sel-p title))))
(when (>= y-off (1- dh)) (return))
(cl-tty.backend:draw-text be (1+ mx) (+ my y-off) text
(cond (cat (theme-color :dim))
(sel-p (theme-color :highlight))
(t (theme-color :agent)))
nil :bold sel-p)
(incf y-off)))))))
(let ((ds (st :dialog-stack)))
(when ds
(let* ((dlg (car ds))
(sel (cl-tty.dialog:dialog-content dlg))
(filtered (cl-tty.select:select-filtered-options sel))
(sel-idx (cl-tty.select:select-selected-index sel))
(cnt (length filtered))
(dw 60) (dh (min 20 (+ 4 cnt)))
(mx (floor (- w dw) 2))
(my 3))
(dotimes (row h)
(cl-tty.backend:draw-rect be 0 row w 1 :bg (theme-color :status-bg)))
(cl-tty.backend:draw-border be mx my dw dh :style :single
:title (cl-tty.dialog:dialog-title dlg)
:fg (theme-color :user-border))
(let ((y-off 1))
(dolist (item filtered)
(let* ((display-idx (first item))
(option (third item))
(title (getf option :title))
(cat (getf option :category))
(sel-p (eql display-idx sel-idx))
(text (if cat (format nil " ~a" title)
(format nil " ~:[ ~;▸~] ~a" sel-p title))))
(when (>= y-off (1- dh)) (return))
(cl-tty.backend:draw-text be (1+ mx) (+ my y-off) text
(cond (cat (theme-color :dim))
(sel-p (theme-color :accent))
(t (theme-color :agent-fg)))
nil :bold sel-p)
(incf y-off)))))))
(sleep 0.1))))
(disconnect-daemon))))
@@ -1120,25 +1150,27 @@
(fiveam:is (eq nil (st :busy))))
(fiveam:test test-theme
"Contract view: *tui-theme* provides color mappings."
(fiveam:is (eq :green (getf *tui-theme* :user)))
(fiveam:is (eq :white (getf *tui-theme* :agent)))
(fiveam:is (eq :yellow (getf *tui-theme* :system)))
(fiveam:is (eq :cyan (getf *tui-theme* :input)))
"Contract view: *tui-theme* provides warm color mappings."
(fiveam:is (string= "#FFB347" (getf *tui-theme* :user-fg)))
(fiveam:is (string= "#E8D5B7" (getf *tui-theme* :agent-fg)))
(fiveam:is (string= "#C8A87C" (getf *tui-theme* :system)))
(fiveam:is (string= "#E8D5B7" (getf *tui-theme* :input-fg)))
(fiveam:is (string= "#FFFFFF" (theme-color :unknown-role))))
(fiveam:test test-on-key-ctrl-u-clears
"Contract 1/v0.7.0: Ctrl+U clears the input buffer."
"Contract v0.9.0: Ctrl+U (via dispatch-key-event) clears the input buffer."
(init-state)
(dolist (ch '(#\h #\i)) (on-key (char-code ch)))
(on-key 21) ; Ctrl+U
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :u :ctrl t :code 21))
(fiveam:is (string= "" (input-string))))
(fiveam:test test-on-key-ctrl-l-redraws
"Contract 1/v0.7.0: Ctrl+L sets all dirty flags."
"Contract v0.9.0: Ctrl+L (via dispatch-key-event) sets all dirty flags."
(init-state)
(setf (st :dirty) (list nil nil nil))
(on-key 12) ; Ctrl+L
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :l :ctrl t :code 12))
(let ((d (st :dirty)))
(fiveam:is (eq t (first d)))
(fiveam:is (eq t (second d)))))
@@ -1158,7 +1190,7 @@
(init-state)
(dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch)))
(on-key 9)
(fiveam:is (search "dark" (input-string) :test #'char-equal)))
(fiveam:is (search "amber" (input-string) :test #'char-equal)))
;; ── v0.7.1 Streaming ──
@@ -1324,22 +1356,25 @@
;; ── v0.7.2 Gate Trace Toggle (Ctrl+G) ──
(fiveam:test test-ctrlg-toggle-gate-trace
"Contract v0.7.2: Ctrl+G toggles gate-trace collapse state."
"Contract v0.9.0: Ctrl+G (via dispatch-key-event) toggles gate-trace collapse state."
(init-state)
(add-msg :agent "test" :gate-trace '((:gate "shell" :result :passed)))
(on-key 7) ;; Ctrl+G — first press hides
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :g :ctrl t :code 7))
(let* ((msgs (st :messages))
(m (aref msgs (1- (length msgs)))))
(fiveam:is (search "hidden" (getf m :content))))
(on-key 7) ;; second press shows
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :g :ctrl t :code 7))
(let* ((msgs (st :messages))
(m (aref msgs (1- (length msgs)))))
(fiveam:is (search "shown" (getf m :content)))))
(fiveam:test test-ctrlg-no-gate-trace
"Contract v0.7.2: Ctrl+G with no gate trace shows fallback."
"Contract v0.9.0: Ctrl+G (via dispatch-key-event) with no gate trace shows fallback."
(init-state)
(on-key 7)
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :g :ctrl t :code 7))
(let ((m (aref (st :messages) 0)))
(fiveam:is (search "No gate trace" (getf m :content)))))

162
lisp/channel-tui-state.lisp
View File

@@ -13,68 +13,102 @@
(defvar *event-lock* (bt:make-lock "tui-event-lock"))
(defvar *tui-theme*
;; Roles
'(:user :green :agent :white :system :yellow
;; Content
:input :cyan :timestamp :yellow :help :cyan :error :red :warning :yellow
;; Status
:connected :green :disconnected :red :busy :magenta :idle :white
;; Gate trace
:gate-passed :green :gate-blocked :red :gate-approval :yellow
:hitl :magenta
;; Tools (future use)
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
;; Display
:scroll-indicator :cyan :border :white :background :black
;; Differentiator (v0.4.0)
:rule-count :cyan :focus-map :yellow
;; UI
:dim :white :highlight :cyan :accent :green
;; Degraded
:degraded :bright-yellow)
"Color theme plist. 28 semantic keys → hex color strings.
See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
'(:user-fg "#FFB347" :user-bg "#3A2A1A" :user-border "#CC8800"
:agent-header "#D4956A" :agent-fg "#E8D5B7"
:system "#C8A87C"
:input-prompt "#FF8C42" :input-fg "#E8D5B7"
:hint "#A08060"
:status-bg "#2A1F1A" :status-fg "#D4A574"
:dot-connected "#7CCC6C" :dot-disconnected "#E2584A"
:error "#E2584A"
:tool-running "#FF8C42" :tool-done "#7CCC6C" :tool-error "#E2584A"
:separator "#4A3A2A" :accent "#FFB347" :dim "#8B7355")
"Warm amber/gold color theme. 20 semantic keys → hex color strings.")
(defvar *tui-theme-presets*
'(:dark (:user :green :agent :white :system :yellow
:input :cyan :timestamp :yellow :help :cyan :error :red :warning :yellow
:connected :green :disconnected :red :busy :magenta :idle :white
:gate-passed :green :gate-blocked :red :gate-approval :yellow
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
:scroll-indicator :cyan :border :white :background :black
:rule-count :cyan :focus-map :yellow
:dim :white :highlight :cyan :accent :green
:degraded :bright-yellow)
:light (:user :blue :agent :black :system :red
:input :black :timestamp :yellow :help :blue :error :red :warning :yellow
:connected :green :disconnected :red :busy :magenta :idle :black
:gate-passed :green :gate-blocked :red :gate-approval :yellow
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :black
:scroll-indicator :blue :border :black :background :white
:rule-count :blue :focus-map :red
:dim :white :highlight :blue :accent :green
:degraded :bright-yellow)
:gruvbox (:user "#458588" :agent "#ebdbb2" :system "#fabd2f"
:input "#ebdbb2" :timestamp "#928374" :help "#83a598" :error "#fb4934" :warning "#fabd2f"
:connected "#b8bb26" :disconnected "#fb4934" :busy "#d3869b" :idle "#a89984"
:gate-passed "#b8bb26" :gate-blocked "#fb4934" :gate-approval "#fabd2f"
:tool-running "#d3869b" :tool-success "#b8bb26" :tool-failure "#fb4934" :tool-output "#ebdbb2"
:scroll-indicator "#83a598" :border "#a89984" :background "#282828"
:rule-count "#83a598" :focus-map "#fabd2f"
:dim "#928374" :highlight "#83a598" :accent "#b8bb26"
:degraded "#fabd2f")
:solarized (:user "#268bd2" :agent "#839496" :system "#b58900"
:input "#839496" :timestamp "#93a1a1" :help "#2aa198" :error "#dc322f" :warning "#b58900"
:connected "#859900" :disconnected "#dc322f" :busy "#d33682" :idle "#657b83"
:gate-passed "#859900" :gate-blocked "#dc322f" :gate-approval "#b58900"
: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"
:degraded "#b58900"))
"Named theme presets. /theme <name> loads one into *tui-theme*.")
'(:amber (:user-fg "#FFB347" :user-bg "#3A2A1A" :user-border "#CC8800"
:agent-header "#D4956A" :agent-fg "#E8D5B7"
:system "#C8A87C"
:input-prompt "#FF8C42" :input-fg "#E8D5B7"
:hint "#A08060"
:status-bg "#2A1F1A" :status-fg "#D4A574"
:dot-connected "#7CCC6C" :dot-disconnected "#E2584A"
:error "#E2584A"
:tool-running "#FF8C42" :tool-done "#7CCC6C" :tool-error "#E2584A"
:separator "#4A3A2A" :accent "#FFB347" :dim "#8B7355")
:gold (:user-fg "#FFD700" :user-bg "#3A3020" :user-border "#DAA520"
:agent-header "#D4A574" :agent-fg "#F0E6D0"
:system "#C8A87C"
:input-prompt "#FFA500" :input-fg "#F0E6D0"
:hint "#A08060"
:status-bg "#2A1F1A" :status-fg "#DAA520"
:dot-connected "#7CCC6C" :dot-disconnected "#E2584A"
:error "#E2584A"
:tool-running "#FFA500" :tool-done "#7CCC6C" :tool-error "#E2584A"
:separator "#4A3A2A" :accent "#FFD700" :dim "#8B7355")
:terracotta (:user-fg "#E87A5D" :user-bg "#2D1C15" :user-border "#C0684A"
:agent-header "#D4956A" :agent-fg "#E0C8B0"
:system "#A08060"
:input-prompt "#E87A5D" :input-fg "#E0C8B0"
:hint "#8B6F5E"
:status-bg "#1F1410" :status-fg "#D4956A"
:dot-connected "#6CB85C" :dot-disconnected "#D94A3A"
:error "#D94A3A"
:tool-running "#E87A5D" :tool-done "#6CB85C" :tool-error "#D94A3A"
:separator "#3A2820" :accent "#E87A5D" :dim "#7A6050")
:sepia (:user-fg "#C4A882" :user-bg "#2A2218" :user-border "#A08860"
:agent-header "#B89870" :agent-fg "#D4C4A8"
:system "#9A8A6A"
:input-prompt "#C4A882" :input-fg "#D4C4A8"
:hint "#8A7A5E"
:status-bg "#1E1810" :status-fg "#B89870"
:dot-connected "#7AAC5C" :dot-disconnected "#C84A3A"
:error "#C84A3A"
:tool-running "#C4A882" :tool-done "#7AAC5C" :tool-error "#C84A3A"
:separator "#3A3020" :accent "#C4A882" :dim "#7A6A50")
:nord-warm (:user-fg "#D4A574" :user-bg "#2A2220" :user-border "#B8885A"
:agent-header "#C49870" :agent-fg "#E0D0C0"
:system "#A89080"
:input-prompt "#D08770" :input-fg "#E0D0C0"
:hint "#908070"
:status-bg "#1E1A18" :status-fg "#C8A080"
:dot-connected "#7CB860" :dot-disconnected "#D06050"
:error "#D06050"
:tool-running "#D08770" :tool-done "#7CB860" :tool-error "#D06050"
:separator "#3A3030" :accent "#D4A574" :dim "#807060")
:monokai-warm (:user-fg "#E6B87D" :user-bg "#1E1A16" :user-border "#CC9966"
:agent-header "#D4A06A" :agent-fg "#D8C8B0"
:system "#A89070"
:input-prompt "#E6B87D" :input-fg "#D8C8B0"
:hint "#8A7A5E"
:status-bg "#141210" :status-fg "#CC9966"
:dot-connected "#7AB85C" :dot-disconnected "#D94A3A"
:error "#D94A3A"
:tool-running "#E6B87D" :tool-done "#7AB85C" :tool-error "#D94A3A"
:separator "#2E2820" :accent "#E6B87D" :dim "#7A6A50")
:gruvbox-warm (:user-fg "#D8A657" :user-bg "#1D1A16" :user-border "#B8884A"
:agent-header "#C8A070" :agent-fg "#E0C8A8"
:system "#A89070"
:input-prompt "#D8A657" :input-fg "#E0C8A8"
:hint "#8A7A5E"
:status-bg "#141210" :status-fg "#C8A070"
:dot-connected "#7AB85C" :dot-disconnected "#D94A3A"
:error "#D94A3A"
:tool-running "#D8A657" :tool-done "#7AB85C" :tool-error "#D94A3A"
:separator "#2E2820" :accent "#D8A657" :dim "#7A6A50")
:light-amber (:user-fg "#CC6600" :user-bg "#FFF5E6" :user-border "#CC8800"
:agent-header "#8B6914" :agent-fg "#3A2A1A"
:system "#6B5B3E"
:input-prompt "#CC6600" :input-fg "#3A2A1A"
:hint "#8B7355"
:status-bg "#E8D5B7" :status-fg "#3A2A1A"
:dot-connected "#2E8B57" :dot-disconnected "#CC3300"
:error "#CC3300"
:tool-running "#CC6600" :tool-done "#2E8B57" :tool-error "#CC3300"
:separator "#C8B898" :accent "#CC6600" :dim "#8B7355"))
"8 warm theme presets.")
(defvar *tui-theme-current-name* :dark
(defvar *tui-theme-current-name* :amber
"Name of the currently active theme preset.")
(defun theme-save ()
@@ -115,7 +149,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
(:white "#FFFFFF") (:black "#000000")
(:bright-yellow "#FFD700")
(:bright-black "#666666") (:bright-yellow "#FFD700")
(t "#FFFFFF"))))))
(defun st (key) (getf *state* key))
@@ -137,11 +171,13 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:sidebar-width 30 ; v0.8.0
:expand-tool-calls nil ; v0.8.0
:mcp-count 0 ; v0.8.0
:kill-ring nil ; v0.9.0
:dialog-stack nil ; v0.8.0
:minibuffer-active nil ; v0.8.0
:command-palette-active nil ; v0.8.0
:command-palette-dialog nil ; v0.8.0
:dirty (list nil nil nil))))
:command-palette-active nil ; v0.8.0
:command-palette-dialog nil ; v0.8.0
:session-cost 0.0 ; v0.9.0
:dirty (list nil nil nil))))
(defvar *sidebar-panels*
'((:id :gate-trace :title "Gate Trace" :width 28)

329
lisp/channel-tui-view.lisp
View File

@@ -13,43 +13,17 @@ Returns a list of strings, one per line."
(push text lines)
(nreverse lines)))
(defun view-status (fb w)
(let* ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))
(symbol-value (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))))
(bg (if degraded (theme-color :degraded) 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)))))
(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 :accent) 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))
;; Line 4: Degraded mode warning (v0.8.0)
(when degraded
(cl-tty.backend:draw-text fb 1 4 " ⚠ Degraded mode — components unavailable"
(theme-color :warning) (theme-color :degraded)))))
(defun view-status (fb w h)
(let* ((bg (theme-color :status-bg))
(fg (theme-color :status-fg))
(left (format nil " ~a ~a Rules:~a"
(if (st :connected) "●" "○")
(or (st :foveal-id) "passepartout") (or (st :rule-count) 0)))
(right (format nil "$~,2f ~a" (or (st :session-cost) 0.0) (now))))
(dotimes (col w)
(cl-tty.backend:draw-rect fb col (- h 1) 1 1 :bg bg))
(cl-tty.backend:draw-text fb 1 (- h 1) left fg nil)
(cl-tty.backend:draw-text fb (- w (length right) 2) (- h 1) right fg nil)))
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
@@ -70,147 +44,176 @@ Returns a list of strings, one per line."
(if (string= result "") content result))))
(defun view-chat (fb w h)
(let* ((msgs (st :messages))
(total (length msgs))
(max-lines (- h 2))
(is-search (st :search-mode))
(y 1))
;; v0.8.0: search mode header
(let* ((msgs (st :messages)) (total (length msgs))
(max-lines (- h 4)) (is-search (st :search-mode)) (y 0))
(when is-search
(let* ((matches (st :search-matches))
(idx (st :search-match-idx))
(let* ((matches (st :search-matches)) (idx (st :search-match-idx))
(query (st :search-query))
(header (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
(length matches) query (1+ idx) (length matches))))
(cl-tty.backend:draw-text fb 1 y header (theme-color :highlight) nil)
(incf y)
(decf max-lines)))
;; Pre-compute display lines for each message
(let ((msg-lines (make-array total)))
(hdr (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
(length matches) query (1+ idx) (length matches))))
(cl-tty.backend:draw-text fb 1 y hdr (theme-color :accent) nil)
(incf y) (decf max-lines)))
(let ((msg-lines (make-array total)) (msg-heights (make-array total)))
(dotimes (i total)
(let* ((msg (aref msgs i))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(content-show (if is-search (search-highlight content (st :search-query)) content))
(lines (case role
(:user (cl-tty.box:word-wrap
(format nil "│ [~a] ~a" time content-show) (- w 2)))
(:agent (let* ((nodes (cl-tty.markdown:parse-blocks content-show))
(md-lines (and nodes (cl-tty.markdown:render-md nodes))))
(if md-lines
(progn (setf (first md-lines)
(format nil "[~a] ~a" time (first md-lines)))
md-lines)
(list (format nil "[~a] " time)))))
(t (cl-tty.box:word-wrap
(format nil " [~a] ~a" time content-show) (- w 2))))))
;; v0.8.0: tool calls — collapsible
(let* ((msg (aref msgs i)) (role (getf msg :role))
(content (getf msg :content)) (time (or (getf msg :time) ""))
(cs (if is-search (search-highlight content (st :search-query)) content))
(pairs nil))
(case role
(:user
(let* ((top (format nil "┌─ you ~a ─" time))
(top-str (format nil "~a~a┐" top
(make-string (max 0 (- w (length top) 1)) :initial-element #\─)))
(body (cl-tty.box:word-wrap cs (- w 4)))
(pad (- w 3))
(bot (format nil "└~a┘" (make-string (max 0 pad) :initial-element #\─)))
(bdr (theme-color :user-border)))
(push (list top-str bdr) pairs)
(dolist (l body)
(push (list (format nil "│ ~a~a│" l
(make-string (max 0 (- pad (length l))) :initial-element #\Space))
(theme-color :user-fg) (theme-color :user-bg)) pairs))
(push (list bot bdr) pairs)))
(:agent
(let* ((hdr (format nil "── passepartout ~a " time))
(hdr-str (format nil "~a~a" hdr
(make-string (max 0 (- w (length hdr))) :initial-element #\─)))
(nodes (cl-tty.markdown:parse-blocks cs))
(body (or (and nodes (cl-tty.markdown:render-md nodes)) (list ""))))
(push (list hdr-str (theme-color :agent-header)) pairs)
(dolist (l body) (push (list l (theme-color :agent-fg)) pairs))))
(t (dolist (l (cl-tty.box:word-wrap cs (- w 2)))
(push (list l (theme-color :system)) pairs))))
(let ((gt (getf msg :gate-trace)))
(when (and gt (eq role :agent))
(if (member i (st :collapsed-gates))
(push (list (format nil "╎ Gate trace: ~a gates" (length gt))
(theme-color :dim)) pairs)
(dolist (entry (passepartout::gate-trace-lines gt))
(push (list (concatenate 'string "╎ " (car entry))
(theme-color (getf (cdr entry) :fgcolor))) pairs)))))
(let ((tc (getf msg :tool-calls)))
(when tc
(if (st :expand-tool-calls)
(if (member i (st :collapsed-tools))
(let* ((n (or (getf (first tc) :name) "tool"))
(d (or (getf (first tc) :duration) 0.0))
(extra (reduce #'+ tc :key
(lambda (c) (length (cl-tty.box:word-wrap
(or (getf c :output) "") (- w 6)))))))
(push (list (format nil "┌─ ~a ──── ~,1fs ── [+~d more] ────────┐" n d extra)
(theme-color :tool-done)) pairs))
(dolist (call tc)
(setf lines (append lines
(list (format nil " ╎ Tool: ~a" (or (getf call :name) "unknown"))))))
(setf lines (append lines
(list (format nil " ╎ ~a tool call(s)" (length tc))))))))
;; v0.8.0: gate trace — collapsible with left border
(let ((gt (getf msg :gate-trace)))
(when gt
(if (member i (st :collapsed-gates))
(setf lines (append lines
(list (format nil "╎ Gate trace: ~a gates — Ctrl+G toggle"
(length gt)))))
(dolist (entry (passepartout::gate-trace-lines gt))
(setf lines (append lines
(list (concatenate 'string "╎ " (car entry)))))))))
(setf (aref msg-lines i) lines)))
;; Count visible messages from end
(let* ((name (or (getf call :name) "tool"))
(dur (or (getf call :duration) 0.0))
(st (getf call :status))
(out (getf call :output))
(bc (theme-color
(cond ((eq st :running) :tool-running)
((eq st :error) :tool-error)
(t :tool-done))))
(pfx (cond ((eq st :error) "✗") ((eq st :running) "●") (t "✓")))
(ol (when out (cl-tty.box:word-wrap out (- w 6))))
(top (format nil "┌─ ~a ──── ~,1fs ─" name dur))
(top-str (format nil "~a~a┐" top
(make-string (max 0 (- w (length top) 1)) :initial-element #\─)))
(bot (format nil "└~a┘" (make-string (max 0 (- w 2)) :initial-element #\─))))
(push (list top-str bc) pairs)
(dolist (l ol)
(push (list (format nil "│ ~a ~a~a│" pfx l
(make-string (max 0 (- w (length pfx) (length l) 4))
:initial-element #\Space)) bc) pairs))
(push (list bot bc) pairs))))))
(when (> i 0)
(let ((pt (or (getf (aref msgs (1- i)) :time) "")))
(flet ((h (s) (if (> (length s) 0) (subseq s 0 (or (position #\: s) 0)) "")))
(let ((ph (h pt)) (ch (h time)))
(when (and (> (length ch) 0) (string/= ch ph))
(let* ((pad (max 0 (floor (- w (length time) 2) 2)))
(rpad (- w (length time) 2 pad)))
(push (list (format nil "~a ~a ~a"
(make-string pad :initial-element #\─)
time
(make-string rpad :initial-element #\─))
(theme-color :separator)) pairs)))))))
(setf (aref msg-lines i) (nreverse pairs))
(setf (aref msg-heights i) (length pairs))))
(let ((msg-count 0) (lines-remaining max-lines))
(loop for i from (1- total) downto 0
while (> lines-remaining 0)
do (let ((nlines (length (aref msg-lines i))))
(if (<= nlines lines-remaining)
(progn (decf lines-remaining nlines) (incf msg-count))
do (let ((h (aref msg-heights i)))
(if (<= h lines-remaining)
(progn (decf lines-remaining h) (incf msg-count))
(setf lines-remaining 0))))
;; Render from the correct starting message
(let* ((scroll-skip (st :scroll-offset))
(start (max 0 (- total msg-count scroll-skip))))
(loop for i from start below total
while (< y (1- h))
do (let* ((msg (aref msgs i))
(role (getf msg :role))
(lines (aref msg-lines i))
(color (theme-color
(case role
(:user :user) (:agent :agent) (:system :system) (t :agent))))
(is-panel (getf msg :panel))
(is-resolved (getf msg :panel-resolved)))
;; HITL panel coloring
(when is-panel
(setf color (if is-resolved (theme-color :dim) (theme-color :hitl))))
(dolist (line lines)
(when (< y (1- h))
(cl-tty.backend:draw-text fb 1 y line color nil)
(incf y))))))))))
(loop for i from start below total while (< y (- h 4))
do (let ((pairs (aref msg-lines i)))
(dolist (pair pairs)
(when (>= y (- h 4)) (return))
(destructuring-bind (text color &optional bg) pair
(when bg (cl-tty.backend:draw-rect fb 0 y w 1 :bg bg))
(cl-tty.backend:draw-text fb 0 y text color nil))
(incf y)))))))))
(defun view-input (fb w)
(defun view-input (fb w h)
(let* ((text (input-string))
(pos (or (st :cursor-pos) 0))
(display-start (max 0 (- pos (1- w))))
(visible (subseq text display-start (min (length text) (+ display-start w)))))
(cl-tty.backend:draw-text fb 0 0 (format nil "~a " visible) (theme-color :input) nil)))
(cl-tty.backend:draw-text fb 0 (- h 3) (format nil "> ~a" visible) (theme-color :input-fg) nil)
(cl-tty.backend:draw-text fb 0 (- h 2) (format nil " Ctrl+P palette | Up/Dn history | Tab complete")
(theme-color :hint) nil)))
(defun view-sidebar (fb w h)
(let ((x (- w (st :sidebar-width))))
"Render the right-side sidebar panel with warm colors."
(let* ((x (- w (or (st :sidebar-width) 30)))
(y 0))
;; Vertical separator
(dotimes (row h)
(cl-tty.backend:draw-rect fb (1- x) row 1 1 :bg :dim))
;; Render panels
(let ((y 1))
;; Focus panel
(when (st :foveal-id)
(cl-tty.backend:draw-text fb (1+ x) y " Focus" (theme-color :highlight) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~a" (st :foveal-id)) (theme-color :agent) nil)
(incf y 2))
;; Rules panel
(let ((rules (or (st :rule-count) 0)))
(cl-tty.backend:draw-text fb (1+ x) y " Rules" (theme-color :highlight) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~d active" rules) (theme-color :agent) nil)
(incf y 2))
;; Context panel — token gauge
(cl-tty.backend:draw-text fb (1+ x) y " Context" (theme-color :highlight) nil)
(cl-tty.backend:draw-rect fb (1- x) row 1 1 :bg (theme-color :separator)))
;; Focus panel
(cl-tty.backend:draw-text fb (1+ x) (incf y) " FOCUS" (theme-color :accent) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) (incf y) (format nil " ~a" (or (st :foveal-id) "none"))
(theme-color :agent-fg) nil)
(incf y 2)
;; Rules panel
(cl-tty.backend:draw-text fb (1+ x) (incf y) " RULES" (theme-color :accent) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) (incf y) (format nil " ~d active" (or (st :rule-count) 0))
(theme-color :agent-fg) nil)
(incf y 2)
;; Context panel — token gauge
(cl-tty.backend:draw-text fb (1+ x) (incf y) " CONTEXT" (theme-color :accent) nil)
(incf y)
(let* ((msg-count (max 1 (length (st :messages))))
(est (* msg-count 60))
(limit 8192)
(pct (min 100 (floor (* 100 est) limit)))
(bar-len (floor pct 10))
(bar (make-string bar-len :initial-element #\#)))
(cl-tty.backend:draw-text fb (1+ x) (incf y)
(format nil " [~a~a]" bar
(make-string (- 10 bar-len) :initial-element #\Space))
(theme-color :dim) nil)
(incf y)
(let* ((msg-count (length (st :messages)))
(est (* msg-count 60))
(limit 8192)
(pct (min 100 (floor (* 100 est) limit)))
(bar-len (floor pct 10))
(bar (make-string bar-len :initial-element #\#)))
(cl-tty.backend:draw-text fb (1+ x) y (format nil " [~a~a]" bar (make-string (- 10 bar-len) :initial-element #\Space)) (theme-color :dim) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~d%" pct) (theme-color :timestamp) nil)
(incf y 2))
;; MCP count
(let ((mcp (or (st :mcp-count) 0)))
(cl-tty.backend:draw-text fb (1+ x) y " MCP" (theme-color :highlight) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~d server~:p" mcp) (theme-color :agent) nil)))))
(cl-tty.backend:draw-text fb (1+ x) (incf y) (format nil " ~d%" pct)
(theme-color :status-fg) nil)
(incf y 2))
;; MCP panel
(cl-tty.backend:draw-text fb (1+ x) (incf y) " MCP" (theme-color :accent) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) (incf y) (format nil " ~d server~:p" (or (st :mcp-count) 0))
(theme-color :agent-fg) nil)))
(defun redraw (fb w h)
(destructuring-bind (sd cd id) (st :dirty)
(let* ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))
(symbol-value (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))))
(chat-h (- h (if degraded 6 5))))
(when sd (view-status fb w))
(when cd (view-chat fb w chat-h))
(when id (view-input fb w))
(when (and (st :sidebar-visible) (>= w 120))
(view-sidebar fb w h))
(setf (st :dirty) (list nil nil nil)))))
(when sd (view-status fb w h))
(when cd (view-chat fb w h))
(when id (view-input fb w h))
(when (and (st :sidebar-visible) (>= w 120))
(view-sidebar fb w h))
(setf (st :dirty) (list nil nil nil))))
(in-package :passepartout)
@@ -286,8 +289,8 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(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))))
(cond (url (theme-color :accent))
(t (theme-color (or (getf attrs :role) :agent-fg))))
nil
:bold bold)
(incf x (length text))))
@@ -366,10 +369,10 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(reason (getf entry :reason))
(name (or gate "unknown"))
(color (case result
(:passed :gate-passed)
(:blocked :gate-blocked)
(:approval :gate-approval)
(t :dim)))
(:passed :tool-done)
(:blocked :error)
(:approval :accent)
(t :dim)))
(prefix (case result
(:passed " \u2713 ")
(:blocked " \u2717 ")
@@ -468,7 +471,7 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(let ((lines (passepartout::gate-trace-lines
'((:gate "path" :result :passed)))))
(is (= 1 (length lines)))
(is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
(is (eq :tool-done (getf (cdar lines) :fgcolor)))))
(test test-gate-trace-lines-blocked
"Contract 9: gate-trace-lines for blocked gate."
@@ -507,6 +510,6 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(is (not (and (passepartout.channel-tui::st :sidebar-visible) (>= w 120))))))
(test test-status-bar-tokens
"v0.8.0: status bar uses :degraded and :warning theme tokens."
(is (getf passepartout.channel-tui::*tui-theme* :degraded))
(is (getf passepartout.channel-tui::*tui-theme* :warning)))
"v0.9.0: status bar uses :status-fg and :status-bg theme tokens."
(is (getf passepartout.channel-tui::*tui-theme* :status-fg))
(is (getf passepartout.channel-tui::*tui-theme* :status-bg)))

273
org/channel-tui-main.org
View File

@@ -116,54 +116,7 @@ Event handlers + daemon I/O + main loop.
(add-msg :system (format nil "Press Tab to open ~a" url))
(setf (st :dirty) (list t t nil)))
nil))))
;; v0.7.0: Ctrl key bindings
((eql ch 21) ; Ctrl+U — clear line
(setf (st :input-buffer) nil)
(setf (st :dirty) (list nil nil t)))
((eql ch 23) ; Ctrl+W — delete word backward
(let ((buf (st :input-buffer)))
(loop while (and buf (char= (first buf) #\Space)) do (pop buf))
(loop while (and buf (char/= (first buf) #\Space)) do (pop buf))
(setf (st :input-buffer) buf)
(setf (st :dirty) (list nil nil t))))
((eql ch 1) ; Ctrl+A — home
(setf (st :cursor-pos) 0))
((eql ch 5) ; Ctrl+E — end
(setf (st :cursor-pos) (length (st :input-buffer))))
((eql ch 12) ; Ctrl+L — redraw
(setf (st :dirty) (list t t t)))
((eql ch 4) ; Ctrl+D — quit on empty
(when (or (null (st :input-buffer)) (string= "" (input-string)))
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit.")))
((eql ch 6) ; v0.7.2 Ctrl+F — message search
(add-msg :system "Use /search <query> to find messages"))
((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse
(let ((gate-idx nil))
(loop for i from (1- (length (st :messages))) downto 0
for m = (aref (st :messages) i)
when (and (getf m :gate-trace) (listp (getf m :gate-trace)))
do (setf gate-idx i) (loop-finish))
(if gate-idx
(let ((cg (st :collapsed-gates)))
(if (member gate-idx cg)
(setf (st :collapsed-gates) (remove gate-idx cg))
(push gate-idx (st :collapsed-gates)))
(add-msg :system (format nil "Gate trace ~a for msg ~a"
(if (member gate-idx (st :collapsed-gates)) "hidden" "shown")
gate-idx))
(setf (st :dirty) (list nil t nil)))
(add-msg :system "No gate trace to toggle"))))
((eql ch 24) ; Ctrl+X prefix
(setf (st :pending-ctrl-x) t))
((and (st :pending-ctrl-x) (eql ch 5)) ; Ctrl+X+E — editor
(setf (st :pending-ctrl-x) nil)
(add-msg :system "Opening $EDITOR... save and exit to return.")
(setf (st :dirty) (list t t nil)))
((and (st :pending-ctrl-x) (not (eql ch 5))) ; cancel Ctrl+X
(setf (st :pending-ctrl-x) nil)
(on-key ch)
(return-from on-key nil))
;; Enter
;; Enter
((or (eq ch :enter) (eql ch 13) (eql ch 10) (eql ch 343)
(eql ch #\Newline) (eql ch #\Return))
;; Multi-line: if buffer ends with \, strip it and insert newline
@@ -421,19 +374,19 @@ Event handlers + daemon I/O + main loop.
(add-msg :system "Ctrl+G Toggle gate trace"))
;; /theme command
((string-equal text "/theme")
(add-msg :system (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a"
(add-msg :system (format nil "Theme: ~a — user-fg=~a agent-fg=~a system=~a input-fg=~a"
*tui-theme-current-name*
(getf *tui-theme* :user)
(getf *tui-theme* :agent)
(getf *tui-theme* :user-fg)
(getf *tui-theme* :agent-fg)
(getf *tui-theme* :system)
(getf *tui-theme* :input)))
(add-msg :system "Presets: /theme dark | light | solarized | gruvbox"))
(getf *tui-theme* :input-fg)))
(add-msg :system "Presets: /theme amber | gold | terracotta | sepia | nord-warm | monokai-warm | gruvbox-warm | light-amber"))
((and (>= (length text) 7)
(string-equal (subseq text 0 7) "/theme "))
(let ((name (string-trim '(#\Space) (subseq text 7))))
(if (theme-switch name)
(add-msg :system (format nil "Theme switched to ~a" name))
(add-msg :system (format nil "Unknown theme '~a'. Try: dark light solarized gruvbox" name)))))
(if (theme-switch name)
(add-msg :system (format nil "Theme switched to ~a" name))
(add-msg :system (format nil "Unknown theme '~a'. Try: amber gold terracotta sepia nord-warm monokai-warm gruvbox-warm light-amber" name)))))
;; /eval command
((and (>= (length text) 6)
(string-equal (subseq text 0 6) "/eval "))
@@ -519,11 +472,11 @@ Event handlers + daemon I/O + main loop.
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list)))
(setf (st :dirty) (list nil nil t)))))
;; /theme subcommand
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
(let* ((partial (string-trim '(#\Space) (subseq text 7)))
(names '("dark" "light" "solarized" "gruvbox"))
(match (if (string= partial "") (first names)
(find partial names :test #'string-equal))))
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
(let* ((partial (string-trim '(#\Space) (subseq text 7)))
(names '("amber" "gold" "terracotta" "sepia" "nord-warm" "monokai-warm" "gruvbox-warm" "light-amber"))
(match (if (string= partial "") (first names)
(find partial names :test #'string-equal))))
(when match
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list)))
(setf (st :dirty) (list nil nil t)))))
@@ -629,15 +582,15 @@ Event handlers + daemon I/O + main loop.
;; v0.8.0 — command palette for daemon commands (Ctrl+P)
(defun command-palette-show-commands ()
(let* ((on-select (lambda (opt)
(let ((cmd (getf opt :value)))
(pop (st :dialog-stack))
(setf (st :command-palette-active) nil)
(add-msg :system (format nil "Dispatching: ~s" cmd))
(send-daemon (list :type :event :payload cmd))
(setf (st :busy) t)
(setf (st :dirty) (list t t nil)))))
(sel (cl-tty.select:make-select :options *daemon-commands* :on-select on-select))
(let* ((on-select (lambda (cmd)
(pop (st :dialog-stack))
(setf (st :command-palette-active) nil)
(let ((action (getf cmd :value)))
(send-daemon (list :type :event :payload action))
(add-msg :system (format nil "Sent: ~a" action)))
(setf (st :dirty) (list t t nil))))
(sel (cl-tty.select:make-select :options *daemon-commands*
:on-select on-select))
(dlg (make-instance 'cl-tty.dialog:dialog
:title "Command Palette"
:content sel)))
@@ -863,7 +816,69 @@ Event handlers + daemon I/O + main loop.
(setf (st :dirty) (list nil t nil))))
(:npage (lambda (e) (declare (ignore e))
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10)))
(setf (st :dirty) (list nil t nil))))))
(setf (st :dirty) (list nil t nil))))
;; v0.9.0 — Readline keybindings
(:ctrl+a (lambda (e) (declare (ignore e))
(setf (st :cursor-pos) 0)))
(:ctrl+e (lambda (e) (declare (ignore e))
(setf (st :cursor-pos) (length (st :input-buffer)))))
(:ctrl+u (lambda (e) (declare (ignore e))
(setf (st :input-buffer) nil)
(setf (st :cursor-pos) 0)
(setf (st :dirty) (list nil nil t))))
(:ctrl+w (lambda (e) (declare (ignore e))
(let ((buf (st :input-buffer)))
(loop while (and buf (char= (first buf) #\Space)) do (pop buf))
(loop while (and buf (char/= (first buf) #\Space)) do (pop buf))
(setf (st :input-buffer) buf)
(setf (st :dirty) (list nil nil t)))))
(:ctrl+k (lambda (e) (declare (ignore e))
(let* ((s (input-string))
(pos (or (st :cursor-pos) 0))
(killed (subseq s pos)))
(setf (st :kill-ring) killed)
(setf (st :input-buffer) (reverse (coerce (subseq s 0 pos) 'list)))
(setf (st :dirty) (list nil nil t)))))
(:ctrl+y (lambda (e) (declare (ignore e))
(let ((killed (st :kill-ring)))
(when killed
(dolist (ch (reverse (coerce killed 'list)))
(push ch (st :input-buffer)))
(setf (st :cursor-pos) (length (st :input-buffer)))
(setf (st :dirty) (list nil nil t))))))
(:ctrl+l (lambda (e) (declare (ignore e))
(setf (st :dirty) (list t t t))))
(:ctrl+d (lambda (e) (declare (ignore e))
(when (or (null (st :input-buffer)) (string= "" (input-string)))
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))))
(:ctrl+f (lambda (e) (declare (ignore e))
(add-msg :system "Use /search <query> to find messages")))
(:ctrl+g (lambda (e) (declare (ignore e))
(let ((gate-idx nil))
(loop for i from (1- (length (st :messages))) downto 0
for m = (aref (st :messages) i)
when (and (getf m :gate-trace) (listp (getf m :gate-trace)))
do (setf gate-idx i) (loop-finish))
(if gate-idx
(let ((cg (st :collapsed-gates)))
(if (member gate-idx cg)
(setf (st :collapsed-gates) (remove gate-idx cg))
(push gate-idx (st :collapsed-gates)))
(add-msg :system (format nil "Gate trace ~a for msg ~a"
(if (member gate-idx (st :collapsed-gates)) "hidden" "shown")
gate-idx))
(setf (st :dirty) (list nil t nil)))
(add-msg :system "No gate trace to toggle")))))
(:alt+enter (lambda (e) (declare (ignore e))
(push #\Newline (st :input-buffer))
(setf (st :dirty) (list nil nil t))))
;; v0.9.0 — Ctrl+X prefix + help
(:ctrl+x (lambda (e) (declare (ignore e))
(setf (st :pending-ctrl-x) t)))
(:? (lambda (e) (declare (ignore e))
(add-msg :system "Keybindings: Ctrl+P palette | Ctrl+B sidebar | Ctrl+F search | Ctrl+L redraw | Ctrl+D quit | Ctrl+Q quit | PageUp/Dn scroll | Esc interrupt | Tab complete | Up/Dn history")
(add-msg :system "Commands: /eval <expr> | /undo | /redo | /why | /identity | /tags | /audit | /search | /context | /focus | /scope | /unfocus | /theme | /reconnect | /help")
(setf (st :dirty) (list t t nil))))))
;; v0.8.0 — Prompt/local keymap (for when input is active)
(eval-when (:load-toplevel :execute)
@@ -950,44 +965,59 @@ Event handlers + daemon I/O + main loop.
(let ((f (cl-tty.select:select-filter sel)))
(when (> (length f) 0)
(setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f)))))))))
((cl-tty.input:dispatch-key-event data)
nil)
(t (on-key ch)))))))
;; v0.9.0 — Mouse wheel support
((cl-tty.input:mouse-event-p data)
(let ((btn (cl-tty.input:mouse-event-button data)))
(cond
((eql btn :scroll-up)
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 3))))
(setf (st :dirty) (list nil t nil)))
((eql btn :scroll-down)
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 3)))
(setf (st :dirty) (list nil t nil))))))
((cl-tty.input:dispatch-key-event data)
nil)
(t (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
(cl-tty.backend:backend-clear be)
(redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
;; Draw separator line above input
(cl-tty.backend:draw-text be 0 (- h 4) (make-string w :initial-element #\─)
(theme-color :separator) nil)
(rotatef prev-fb curr-fb))
(let ((ds (st :dialog-stack)))
(when ds
(let* ((dlg (car ds))
(sel (cl-tty.dialog:dialog-content dlg))
(filtered (cl-tty.select:select-filtered-options sel))
(sel-idx (cl-tty.select:select-selected-index sel))
(cnt (length filtered))
(dw 60) (dh (min 20 (+ 4 cnt)))
(mx (floor (- w dw) 2))
(my (floor (- h dh) 2)))
(dotimes (row h)
(cl-tty.backend:draw-rect be 0 row w 1 :bg :bright-black))
(cl-tty.backend:draw-border be mx my dw dh :style :single
:title (cl-tty.dialog:dialog-title dlg))
(let ((y-off 1))
(dolist (item filtered)
(let* ((display-idx (first item))
(option (third item))
(title (getf option :title))
(cat (getf option :category))
(sel-p (eql display-idx sel-idx))
(text (if cat (format nil " ~a" title)
(format nil " ~:[ ~;▸~] ~a" sel-p title))))
(when (>= y-off (1- dh)) (return))
(cl-tty.backend:draw-text be (1+ mx) (+ my y-off) text
(cond (cat (theme-color :dim))
(sel-p (theme-color :highlight))
(t (theme-color :agent)))
nil :bold sel-p)
(incf y-off)))))))
(let ((ds (st :dialog-stack)))
(when ds
(let* ((dlg (car ds))
(sel (cl-tty.dialog:dialog-content dlg))
(filtered (cl-tty.select:select-filtered-options sel))
(sel-idx (cl-tty.select:select-selected-index sel))
(cnt (length filtered))
(dw 60) (dh (min 20 (+ 4 cnt)))
(mx (floor (- w dw) 2))
(my 3))
(dotimes (row h)
(cl-tty.backend:draw-rect be 0 row w 1 :bg (theme-color :status-bg)))
(cl-tty.backend:draw-border be mx my dw dh :style :single
:title (cl-tty.dialog:dialog-title dlg)
:fg (theme-color :user-border))
(let ((y-off 1))
(dolist (item filtered)
(let* ((display-idx (first item))
(option (third item))
(title (getf option :title))
(cat (getf option :category))
(sel-p (eql display-idx sel-idx))
(text (if cat (format nil " ~a" title)
(format nil " ~:[ ~;▸~] ~a" sel-p title))))
(when (>= y-off (1- dh)) (return))
(cl-tty.backend:draw-text be (1+ mx) (+ my y-off) text
(cond (cat (theme-color :dim))
(sel-p (theme-color :accent))
(t (theme-color :agent-fg)))
nil :bold sel-p)
(incf y-off)))))))
(sleep 0.1))))
(disconnect-daemon))))
#+END_SRC
@@ -1167,25 +1197,27 @@ Event handlers + daemon I/O + main loop.
(fiveam:is (eq nil (st :busy))))
(fiveam:test test-theme
"Contract view: *tui-theme* provides color mappings."
(fiveam:is (eq :green (getf *tui-theme* :user)))
(fiveam:is (eq :white (getf *tui-theme* :agent)))
(fiveam:is (eq :yellow (getf *tui-theme* :system)))
(fiveam:is (eq :cyan (getf *tui-theme* :input)))
"Contract view: *tui-theme* provides warm color mappings."
(fiveam:is (string= "#FFB347" (getf *tui-theme* :user-fg)))
(fiveam:is (string= "#E8D5B7" (getf *tui-theme* :agent-fg)))
(fiveam:is (string= "#C8A87C" (getf *tui-theme* :system)))
(fiveam:is (string= "#E8D5B7" (getf *tui-theme* :input-fg)))
(fiveam:is (string= "#FFFFFF" (theme-color :unknown-role))))
(fiveam:test test-on-key-ctrl-u-clears
"Contract 1/v0.7.0: Ctrl+U clears the input buffer."
"Contract v0.9.0: Ctrl+U (via dispatch-key-event) clears the input buffer."
(init-state)
(dolist (ch '(#\h #\i)) (on-key (char-code ch)))
(on-key 21) ; Ctrl+U
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :u :ctrl t :code 21))
(fiveam:is (string= "" (input-string))))
(fiveam:test test-on-key-ctrl-l-redraws
"Contract 1/v0.7.0: Ctrl+L sets all dirty flags."
"Contract v0.9.0: Ctrl+L (via dispatch-key-event) sets all dirty flags."
(init-state)
(setf (st :dirty) (list nil nil nil))
(on-key 12) ; Ctrl+L
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :l :ctrl t :code 12))
(let ((d (st :dirty)))
(fiveam:is (eq t (first d)))
(fiveam:is (eq t (second d)))))
@@ -1205,7 +1237,7 @@ Event handlers + daemon I/O + main loop.
(init-state)
(dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch)))
(on-key 9)
(fiveam:is (search "dark" (input-string) :test #'char-equal)))
(fiveam:is (search "amber" (input-string) :test #'char-equal)))
;; ── v0.7.1 Streaming ──
@@ -1371,22 +1403,25 @@ Event handlers + daemon I/O + main loop.
;; ── v0.7.2 Gate Trace Toggle (Ctrl+G) ──
(fiveam:test test-ctrlg-toggle-gate-trace
"Contract v0.7.2: Ctrl+G toggles gate-trace collapse state."
"Contract v0.9.0: Ctrl+G (via dispatch-key-event) toggles gate-trace collapse state."
(init-state)
(add-msg :agent "test" :gate-trace '((:gate "shell" :result :passed)))
(on-key 7) ;; Ctrl+G — first press hides
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :g :ctrl t :code 7))
(let* ((msgs (st :messages))
(m (aref msgs (1- (length msgs)))))
(fiveam:is (search "hidden" (getf m :content))))
(on-key 7) ;; second press shows
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :g :ctrl t :code 7))
(let* ((msgs (st :messages))
(m (aref msgs (1- (length msgs)))))
(fiveam:is (search "shown" (getf m :content)))))
(fiveam:test test-ctrlg-no-gate-trace
"Contract v0.7.2: Ctrl+G with no gate trace shows fallback."
"Contract v0.9.0: Ctrl+G (via dispatch-key-event) with no gate trace shows fallback."
(init-state)
(on-key 7)
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :g :ctrl t :code 7))
(let ((m (aref (st :messages) 0)))
(fiveam:is (search "No gate trace" (getf m :content)))))

162
org/channel-tui-state.org
View File

@@ -33,68 +33,102 @@ All state mutation flows through event handlers in the controller.
(defvar *event-lock* (bt:make-lock "tui-event-lock"))
(defvar *tui-theme*
;; Roles
'(:user :green :agent :white :system :yellow
;; Content
:input :cyan :timestamp :yellow :help :cyan :error :red :warning :yellow
;; Status
:connected :green :disconnected :red :busy :magenta :idle :white
;; Gate trace
:gate-passed :green :gate-blocked :red :gate-approval :yellow
:hitl :magenta
;; Tools (future use)
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
;; Display
:scroll-indicator :cyan :border :white :background :black
;; Differentiator (v0.4.0)
:rule-count :cyan :focus-map :yellow
;; UI
:dim :white :highlight :cyan :accent :green
;; Degraded
:degraded :bright-yellow)
"Color theme plist. 28 semantic keys → hex color strings.
See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
'(:user-fg "#FFB347" :user-bg "#3A2A1A" :user-border "#CC8800"
:agent-header "#D4956A" :agent-fg "#E8D5B7"
:system "#C8A87C"
:input-prompt "#FF8C42" :input-fg "#E8D5B7"
:hint "#A08060"
:status-bg "#2A1F1A" :status-fg "#D4A574"
:dot-connected "#7CCC6C" :dot-disconnected "#E2584A"
:error "#E2584A"
:tool-running "#FF8C42" :tool-done "#7CCC6C" :tool-error "#E2584A"
:separator "#4A3A2A" :accent "#FFB347" :dim "#8B7355")
"Warm amber/gold color theme. 20 semantic keys → hex color strings.")
(defvar *tui-theme-presets*
'(:dark (:user :green :agent :white :system :yellow
:input :cyan :timestamp :yellow :help :cyan :error :red :warning :yellow
:connected :green :disconnected :red :busy :magenta :idle :white
:gate-passed :green :gate-blocked :red :gate-approval :yellow
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
:scroll-indicator :cyan :border :white :background :black
:rule-count :cyan :focus-map :yellow
:dim :white :highlight :cyan :accent :green
:degraded :bright-yellow)
:light (:user :blue :agent :black :system :red
:input :black :timestamp :yellow :help :blue :error :red :warning :yellow
:connected :green :disconnected :red :busy :magenta :idle :black
:gate-passed :green :gate-blocked :red :gate-approval :yellow
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :black
:scroll-indicator :blue :border :black :background :white
:rule-count :blue :focus-map :red
:dim :white :highlight :blue :accent :green
:degraded :bright-yellow)
:gruvbox (:user "#458588" :agent "#ebdbb2" :system "#fabd2f"
:input "#ebdbb2" :timestamp "#928374" :help "#83a598" :error "#fb4934" :warning "#fabd2f"
:connected "#b8bb26" :disconnected "#fb4934" :busy "#d3869b" :idle "#a89984"
:gate-passed "#b8bb26" :gate-blocked "#fb4934" :gate-approval "#fabd2f"
:tool-running "#d3869b" :tool-success "#b8bb26" :tool-failure "#fb4934" :tool-output "#ebdbb2"
:scroll-indicator "#83a598" :border "#a89984" :background "#282828"
:rule-count "#83a598" :focus-map "#fabd2f"
:dim "#928374" :highlight "#83a598" :accent "#b8bb26"
:degraded "#fabd2f")
:solarized (:user "#268bd2" :agent "#839496" :system "#b58900"
:input "#839496" :timestamp "#93a1a1" :help "#2aa198" :error "#dc322f" :warning "#b58900"
:connected "#859900" :disconnected "#dc322f" :busy "#d33682" :idle "#657b83"
:gate-passed "#859900" :gate-blocked "#dc322f" :gate-approval "#b58900"
: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"
:degraded "#b58900"))
"Named theme presets. /theme <name> loads one into *tui-theme*.")
'(:amber (:user-fg "#FFB347" :user-bg "#3A2A1A" :user-border "#CC8800"
:agent-header "#D4956A" :agent-fg "#E8D5B7"
:system "#C8A87C"
:input-prompt "#FF8C42" :input-fg "#E8D5B7"
:hint "#A08060"
:status-bg "#2A1F1A" :status-fg "#D4A574"
:dot-connected "#7CCC6C" :dot-disconnected "#E2584A"
:error "#E2584A"
:tool-running "#FF8C42" :tool-done "#7CCC6C" :tool-error "#E2584A"
:separator "#4A3A2A" :accent "#FFB347" :dim "#8B7355")
:gold (:user-fg "#FFD700" :user-bg "#3A3020" :user-border "#DAA520"
:agent-header "#D4A574" :agent-fg "#F0E6D0"
:system "#C8A87C"
:input-prompt "#FFA500" :input-fg "#F0E6D0"
:hint "#A08060"
:status-bg "#2A1F1A" :status-fg "#DAA520"
:dot-connected "#7CCC6C" :dot-disconnected "#E2584A"
:error "#E2584A"
:tool-running "#FFA500" :tool-done "#7CCC6C" :tool-error "#E2584A"
:separator "#4A3A2A" :accent "#FFD700" :dim "#8B7355")
:terracotta (:user-fg "#E87A5D" :user-bg "#2D1C15" :user-border "#C0684A"
:agent-header "#D4956A" :agent-fg "#E0C8B0"
:system "#A08060"
:input-prompt "#E87A5D" :input-fg "#E0C8B0"
:hint "#8B6F5E"
:status-bg "#1F1410" :status-fg "#D4956A"
:dot-connected "#6CB85C" :dot-disconnected "#D94A3A"
:error "#D94A3A"
:tool-running "#E87A5D" :tool-done "#6CB85C" :tool-error "#D94A3A"
:separator "#3A2820" :accent "#E87A5D" :dim "#7A6050")
:sepia (:user-fg "#C4A882" :user-bg "#2A2218" :user-border "#A08860"
:agent-header "#B89870" :agent-fg "#D4C4A8"
:system "#9A8A6A"
:input-prompt "#C4A882" :input-fg "#D4C4A8"
:hint "#8A7A5E"
:status-bg "#1E1810" :status-fg "#B89870"
:dot-connected "#7AAC5C" :dot-disconnected "#C84A3A"
:error "#C84A3A"
:tool-running "#C4A882" :tool-done "#7AAC5C" :tool-error "#C84A3A"
:separator "#3A3020" :accent "#C4A882" :dim "#7A6A50")
:nord-warm (:user-fg "#D4A574" :user-bg "#2A2220" :user-border "#B8885A"
:agent-header "#C49870" :agent-fg "#E0D0C0"
:system "#A89080"
:input-prompt "#D08770" :input-fg "#E0D0C0"
:hint "#908070"
:status-bg "#1E1A18" :status-fg "#C8A080"
:dot-connected "#7CB860" :dot-disconnected "#D06050"
:error "#D06050"
:tool-running "#D08770" :tool-done "#7CB860" :tool-error "#D06050"
:separator "#3A3030" :accent "#D4A574" :dim "#807060")
:monokai-warm (:user-fg "#E6B87D" :user-bg "#1E1A16" :user-border "#CC9966"
:agent-header "#D4A06A" :agent-fg "#D8C8B0"
:system "#A89070"
:input-prompt "#E6B87D" :input-fg "#D8C8B0"
:hint "#8A7A5E"
:status-bg "#141210" :status-fg "#CC9966"
:dot-connected "#7AB85C" :dot-disconnected "#D94A3A"
:error "#D94A3A"
:tool-running "#E6B87D" :tool-done "#7AB85C" :tool-error "#D94A3A"
:separator "#2E2820" :accent "#E6B87D" :dim "#7A6A50")
:gruvbox-warm (:user-fg "#D8A657" :user-bg "#1D1A16" :user-border "#B8884A"
:agent-header "#C8A070" :agent-fg "#E0C8A8"
:system "#A89070"
:input-prompt "#D8A657" :input-fg "#E0C8A8"
:hint "#8A7A5E"
:status-bg "#141210" :status-fg "#C8A070"
:dot-connected "#7AB85C" :dot-disconnected "#D94A3A"
:error "#D94A3A"
:tool-running "#D8A657" :tool-done "#7AB85C" :tool-error "#D94A3A"
:separator "#2E2820" :accent "#D8A657" :dim "#7A6A50")
:light-amber (:user-fg "#CC6600" :user-bg "#FFF5E6" :user-border "#CC8800"
:agent-header "#8B6914" :agent-fg "#3A2A1A"
:system "#6B5B3E"
:input-prompt "#CC6600" :input-fg "#3A2A1A"
:hint "#8B7355"
:status-bg "#E8D5B7" :status-fg "#3A2A1A"
:dot-connected "#2E8B57" :dot-disconnected "#CC3300"
:error "#CC3300"
:tool-running "#CC6600" :tool-done "#2E8B57" :tool-error "#CC3300"
:separator "#C8B898" :accent "#CC6600" :dim "#8B7355"))
"8 warm theme presets.")
(defvar *tui-theme-current-name* :dark
(defvar *tui-theme-current-name* :amber
"Name of the currently active theme preset.")
(defun theme-save ()
@@ -135,7 +169,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
(:white "#FFFFFF") (:black "#000000")
(:bright-yellow "#FFD700")
(:bright-black "#666666") (:bright-yellow "#FFD700")
(t "#FFFFFF"))))))
(defun st (key) (getf *state* key))
@@ -157,11 +191,13 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:sidebar-width 30 ; v0.8.0
:expand-tool-calls nil ; v0.8.0
:mcp-count 0 ; v0.8.0
:kill-ring nil ; v0.9.0
:dialog-stack nil ; v0.8.0
:minibuffer-active nil ; v0.8.0
:command-palette-active nil ; v0.8.0
:command-palette-dialog nil ; v0.8.0
:dirty (list nil nil nil))))
:command-palette-active nil ; v0.8.0
:command-palette-dialog nil ; v0.8.0
:session-cost 0.0 ; v0.9.0
:dirty (list nil nil nil))))
#+END_SRC
** Sidebar panel definitions

329
org/channel-tui-view.org
View File

@@ -58,43 +58,17 @@ Returns a list of strings, one per line."
(push text lines)
(nreverse lines)))
(defun view-status (fb w)
(let* ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))
(symbol-value (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))))
(bg (if degraded (theme-color :degraded) 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)))))
(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 :accent) 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))
;; Line 4: Degraded mode warning (v0.8.0)
(when degraded
(cl-tty.backend:draw-text fb 1 4 " ⚠ Degraded mode — components unavailable"
(theme-color :warning) (theme-color :degraded)))))
(defun view-status (fb w h)
(let* ((bg (theme-color :status-bg))
(fg (theme-color :status-fg))
(left (format nil " ~a ~a Rules:~a"
(if (st :connected) "●" "○")
(or (st :foveal-id) "passepartout") (or (st :rule-count) 0)))
(right (format nil "$~,2f ~a" (or (st :session-cost) 0.0) (now))))
(dotimes (col w)
(cl-tty.backend:draw-rect fb col (- h 1) 1 1 :bg bg))
(cl-tty.backend:draw-text fb 1 (- h 1) left fg nil)
(cl-tty.backend:draw-text fb (- w (length right) 2) (- h 1) right fg nil)))
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
@@ -115,156 +89,185 @@ Returns a list of strings, one per line."
(if (string= result "") content result))))
(defun view-chat (fb w h)
(let* ((msgs (st :messages))
(total (length msgs))
(max-lines (- h 2))
(is-search (st :search-mode))
(y 1))
;; v0.8.0: search mode header
(let* ((msgs (st :messages)) (total (length msgs))
(max-lines (- h 4)) (is-search (st :search-mode)) (y 0))
(when is-search
(let* ((matches (st :search-matches))
(idx (st :search-match-idx))
(let* ((matches (st :search-matches)) (idx (st :search-match-idx))
(query (st :search-query))
(header (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
(length matches) query (1+ idx) (length matches))))
(cl-tty.backend:draw-text fb 1 y header (theme-color :highlight) nil)
(incf y)
(decf max-lines)))
;; Pre-compute display lines for each message
(let ((msg-lines (make-array total)))
(hdr (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
(length matches) query (1+ idx) (length matches))))
(cl-tty.backend:draw-text fb 1 y hdr (theme-color :accent) nil)
(incf y) (decf max-lines)))
(let ((msg-lines (make-array total)) (msg-heights (make-array total)))
(dotimes (i total)
(let* ((msg (aref msgs i))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(content-show (if is-search (search-highlight content (st :search-query)) content))
(lines (case role
(:user (cl-tty.box:word-wrap
(format nil "│ [~a] ~a" time content-show) (- w 2)))
(:agent (let* ((nodes (cl-tty.markdown:parse-blocks content-show))
(md-lines (and nodes (cl-tty.markdown:render-md nodes))))
(if md-lines
(progn (setf (first md-lines)
(format nil "[~a] ~a" time (first md-lines)))
md-lines)
(list (format nil "[~a] " time)))))
(t (cl-tty.box:word-wrap
(format nil " [~a] ~a" time content-show) (- w 2))))))
;; v0.8.0: tool calls — collapsible
(let* ((msg (aref msgs i)) (role (getf msg :role))
(content (getf msg :content)) (time (or (getf msg :time) ""))
(cs (if is-search (search-highlight content (st :search-query)) content))
(pairs nil))
(case role
(:user
(let* ((top (format nil "┌─ you ~a ─" time))
(top-str (format nil "~a~a┐" top
(make-string (max 0 (- w (length top) 1)) :initial-element #\─)))
(body (cl-tty.box:word-wrap cs (- w 4)))
(pad (- w 3))
(bot (format nil "└~a┘" (make-string (max 0 pad) :initial-element #\─)))
(bdr (theme-color :user-border)))
(push (list top-str bdr) pairs)
(dolist (l body)
(push (list (format nil "│ ~a~a│" l
(make-string (max 0 (- pad (length l))) :initial-element #\Space))
(theme-color :user-fg) (theme-color :user-bg)) pairs))
(push (list bot bdr) pairs)))
(:agent
(let* ((hdr (format nil "── passepartout ~a " time))
(hdr-str (format nil "~a~a" hdr
(make-string (max 0 (- w (length hdr))) :initial-element #\─)))
(nodes (cl-tty.markdown:parse-blocks cs))
(body (or (and nodes (cl-tty.markdown:render-md nodes)) (list ""))))
(push (list hdr-str (theme-color :agent-header)) pairs)
(dolist (l body) (push (list l (theme-color :agent-fg)) pairs))))
(t (dolist (l (cl-tty.box:word-wrap cs (- w 2)))
(push (list l (theme-color :system)) pairs))))
(let ((gt (getf msg :gate-trace)))
(when (and gt (eq role :agent))
(if (member i (st :collapsed-gates))
(push (list (format nil "╎ Gate trace: ~a gates" (length gt))
(theme-color :dim)) pairs)
(dolist (entry (passepartout::gate-trace-lines gt))
(push (list (concatenate 'string "╎ " (car entry))
(theme-color (getf (cdr entry) :fgcolor))) pairs)))))
(let ((tc (getf msg :tool-calls)))
(when tc
(if (st :expand-tool-calls)
(if (member i (st :collapsed-tools))
(let* ((n (or (getf (first tc) :name) "tool"))
(d (or (getf (first tc) :duration) 0.0))
(extra (reduce #'+ tc :key
(lambda (c) (length (cl-tty.box:word-wrap
(or (getf c :output) "") (- w 6)))))))
(push (list (format nil "┌─ ~a ──── ~,1fs ── [+~d more] ────────┐" n d extra)
(theme-color :tool-done)) pairs))
(dolist (call tc)
(setf lines (append lines
(list (format nil " ╎ Tool: ~a" (or (getf call :name) "unknown"))))))
(setf lines (append lines
(list (format nil " ╎ ~a tool call(s)" (length tc))))))))
;; v0.8.0: gate trace — collapsible with left border
(let ((gt (getf msg :gate-trace)))
(when gt
(if (member i (st :collapsed-gates))
(setf lines (append lines
(list (format nil "╎ Gate trace: ~a gates — Ctrl+G toggle"
(length gt)))))
(dolist (entry (passepartout::gate-trace-lines gt))
(setf lines (append lines
(list (concatenate 'string "╎ " (car entry)))))))))
(setf (aref msg-lines i) lines)))
;; Count visible messages from end
(let* ((name (or (getf call :name) "tool"))
(dur (or (getf call :duration) 0.0))
(st (getf call :status))
(out (getf call :output))
(bc (theme-color
(cond ((eq st :running) :tool-running)
((eq st :error) :tool-error)
(t :tool-done))))
(pfx (cond ((eq st :error) "✗") ((eq st :running) "●") (t "✓")))
(ol (when out (cl-tty.box:word-wrap out (- w 6))))
(top (format nil "┌─ ~a ──── ~,1fs ─" name dur))
(top-str (format nil "~a~a┐" top
(make-string (max 0 (- w (length top) 1)) :initial-element #\─)))
(bot (format nil "└~a┘" (make-string (max 0 (- w 2)) :initial-element #\─))))
(push (list top-str bc) pairs)
(dolist (l ol)
(push (list (format nil "│ ~a ~a~a│" pfx l
(make-string (max 0 (- w (length pfx) (length l) 4))
:initial-element #\Space)) bc) pairs))
(push (list bot bc) pairs))))))
(when (> i 0)
(let ((pt (or (getf (aref msgs (1- i)) :time) "")))
(flet ((h (s) (if (> (length s) 0) (subseq s 0 (or (position #\: s) 0)) "")))
(let ((ph (h pt)) (ch (h time)))
(when (and (> (length ch) 0) (string/= ch ph))
(let* ((pad (max 0 (floor (- w (length time) 2) 2)))
(rpad (- w (length time) 2 pad)))
(push (list (format nil "~a ~a ~a"
(make-string pad :initial-element #\─)
time
(make-string rpad :initial-element #\─))
(theme-color :separator)) pairs)))))))
(setf (aref msg-lines i) (nreverse pairs))
(setf (aref msg-heights i) (length pairs))))
(let ((msg-count 0) (lines-remaining max-lines))
(loop for i from (1- total) downto 0
while (> lines-remaining 0)
do (let ((nlines (length (aref msg-lines i))))
(if (<= nlines lines-remaining)
(progn (decf lines-remaining nlines) (incf msg-count))
do (let ((h (aref msg-heights i)))
(if (<= h lines-remaining)
(progn (decf lines-remaining h) (incf msg-count))
(setf lines-remaining 0))))
;; Render from the correct starting message
(let* ((scroll-skip (st :scroll-offset))
(start (max 0 (- total msg-count scroll-skip))))
(loop for i from start below total
while (< y (1- h))
do (let* ((msg (aref msgs i))
(role (getf msg :role))
(lines (aref msg-lines i))
(color (theme-color
(case role
(:user :user) (:agent :agent) (:system :system) (t :agent))))
(is-panel (getf msg :panel))
(is-resolved (getf msg :panel-resolved)))
;; HITL panel coloring
(when is-panel
(setf color (if is-resolved (theme-color :dim) (theme-color :hitl))))
(dolist (line lines)
(when (< y (1- h))
(cl-tty.backend:draw-text fb 1 y line color nil)
(incf y))))))))))
(loop for i from start below total while (< y (- h 4))
do (let ((pairs (aref msg-lines i)))
(dolist (pair pairs)
(when (>= y (- h 4)) (return))
(destructuring-bind (text color &optional bg) pair
(when bg (cl-tty.backend:draw-rect fb 0 y w 1 :bg bg))
(cl-tty.backend:draw-text fb 0 y text color nil))
(incf y)))))))))
#+END_SRC
** Input Line
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(defun view-input (fb w)
(defun view-input (fb w h)
(let* ((text (input-string))
(pos (or (st :cursor-pos) 0))
(display-start (max 0 (- pos (1- w))))
(visible (subseq text display-start (min (length text) (+ display-start w)))))
(cl-tty.backend:draw-text fb 0 0 (format nil "~a " visible) (theme-color :input) nil)))
(cl-tty.backend:draw-text fb 0 (- h 3) (format nil "> ~a" visible) (theme-color :input-fg) nil)
(cl-tty.backend:draw-text fb 0 (- h 2) (format nil " Ctrl+P palette | Up/Dn history | Tab complete")
(theme-color :hint) nil)))
#+end_src
** Sidebar
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(defun view-sidebar (fb w h)
(let ((x (- w (st :sidebar-width))))
"Render the right-side sidebar panel with warm colors."
(let* ((x (- w (or (st :sidebar-width) 30)))
(y 0))
;; Vertical separator
(dotimes (row h)
(cl-tty.backend:draw-rect fb (1- x) row 1 1 :bg :dim))
;; Render panels
(let ((y 1))
;; Focus panel
(when (st :foveal-id)
(cl-tty.backend:draw-text fb (1+ x) y " Focus" (theme-color :highlight) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~a" (st :foveal-id)) (theme-color :agent) nil)
(incf y 2))
;; Rules panel
(let ((rules (or (st :rule-count) 0)))
(cl-tty.backend:draw-text fb (1+ x) y " Rules" (theme-color :highlight) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~d active" rules) (theme-color :agent) nil)
(incf y 2))
;; Context panel — token gauge
(cl-tty.backend:draw-text fb (1+ x) y " Context" (theme-color :highlight) nil)
(cl-tty.backend:draw-rect fb (1- x) row 1 1 :bg (theme-color :separator)))
;; Focus panel
(cl-tty.backend:draw-text fb (1+ x) (incf y) " FOCUS" (theme-color :accent) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) (incf y) (format nil " ~a" (or (st :foveal-id) "none"))
(theme-color :agent-fg) nil)
(incf y 2)
;; Rules panel
(cl-tty.backend:draw-text fb (1+ x) (incf y) " RULES" (theme-color :accent) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) (incf y) (format nil " ~d active" (or (st :rule-count) 0))
(theme-color :agent-fg) nil)
(incf y 2)
;; Context panel — token gauge
(cl-tty.backend:draw-text fb (1+ x) (incf y) " CONTEXT" (theme-color :accent) nil)
(incf y)
(let* ((msg-count (max 1 (length (st :messages))))
(est (* msg-count 60))
(limit 8192)
(pct (min 100 (floor (* 100 est) limit)))
(bar-len (floor pct 10))
(bar (make-string bar-len :initial-element #\#)))
(cl-tty.backend:draw-text fb (1+ x) (incf y)
(format nil " [~a~a]" bar
(make-string (- 10 bar-len) :initial-element #\Space))
(theme-color :dim) nil)
(incf y)
(let* ((msg-count (length (st :messages)))
(est (* msg-count 60))
(limit 8192)
(pct (min 100 (floor (* 100 est) limit)))
(bar-len (floor pct 10))
(bar (make-string bar-len :initial-element #\#)))
(cl-tty.backend:draw-text fb (1+ x) y (format nil " [~a~a]" bar (make-string (- 10 bar-len) :initial-element #\Space)) (theme-color :dim) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~d%" pct) (theme-color :timestamp) nil)
(incf y 2))
;; MCP count
(let ((mcp (or (st :mcp-count) 0)))
(cl-tty.backend:draw-text fb (1+ x) y " MCP" (theme-color :highlight) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~d server~:p" mcp) (theme-color :agent) nil)))))
(cl-tty.backend:draw-text fb (1+ x) (incf y) (format nil " ~d%" pct)
(theme-color :status-fg) nil)
(incf y 2))
;; MCP panel
(cl-tty.backend:draw-text fb (1+ x) (incf y) " MCP" (theme-color :accent) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) (incf y) (format nil " ~d server~:p" (or (st :mcp-count) 0))
(theme-color :agent-fg) nil)))
#+END_SRC
** Redraw (dirty-flag dispatch)
#+begin_src lisp
(defun redraw (fb w h)
(destructuring-bind (sd cd id) (st :dirty)
(let* ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))
(symbol-value (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))))
(chat-h (- h (if degraded 6 5))))
(when sd (view-status fb w))
(when cd (view-chat fb w chat-h))
(when id (view-input fb w))
(when (and (st :sidebar-visible) (>= w 120))
(view-sidebar fb w h))
(setf (st :dirty) (list nil nil nil)))))
(when sd (view-status fb w h))
(when cd (view-chat fb w h))
(when id (view-input fb w h))
(when (and (st :sidebar-visible) (>= w 120))
(view-sidebar fb w h))
(setf (st :dirty) (list nil nil nil))))
#+END_SRC
* Implementation — v0.7.0 additions
@@ -346,8 +349,8 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(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))))
(cond (url (theme-color :accent))
(t (theme-color (or (getf attrs :role) :agent-fg))))
nil
:bold bold)
(incf x (length text))))
@@ -429,10 +432,10 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(reason (getf entry :reason))
(name (or gate "unknown"))
(color (case result
(:passed :gate-passed)
(:blocked :gate-blocked)
(:approval :gate-approval)
(t :dim)))
(:passed :tool-done)
(:blocked :error)
(:approval :accent)
(t :dim)))
(prefix (case result
(:passed " \u2713 ")
(:blocked " \u2717 ")
@@ -534,7 +537,7 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(let ((lines (passepartout::gate-trace-lines
'((:gate "path" :result :passed)))))
(is (= 1 (length lines)))
(is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
(is (eq :tool-done (getf (cdar lines) :fgcolor)))))
(test test-gate-trace-lines-blocked
"Contract 9: gate-trace-lines for blocked gate."
@@ -573,7 +576,7 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(is (not (and (passepartout.channel-tui::st :sidebar-visible) (>= w 120))))))
(test test-status-bar-tokens
"v0.8.0: status bar uses :degraded and :warning theme tokens."
(is (getf passepartout.channel-tui::*tui-theme* :degraded))
(is (getf passepartout.channel-tui::*tui-theme* :warning)))
"v0.9.0: status bar uses :status-fg and :status-bg theme tokens."
(is (getf passepartout.channel-tui::*tui-theme* :status-fg))
(is (getf passepartout.channel-tui::*tui-theme* :status-bg)))
#+END_SRC