From 15d16fd520b3e0c06b54f7bf6922f6a70b33d773 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Wed, 13 May 2026 19:13:20 -0400 Subject: [PATCH] =?UTF-8?q?bump=20passepartout:=20v0.9.0=20Warm=20TUI=20Re?= =?UTF-8?q?design=20=E2=80=94=20blank=20slate?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- docs/ROADMAP.org | 296 ++++++++++++++++++++++---------- lisp/channel-tui-main.lisp | 275 +++++++++++++++++------------- lisp/channel-tui-state.lisp | 162 +++++++++++------- lisp/channel-tui-view.lisp | 329 ++++++++++++++++++------------------ org/channel-tui-main.org | 275 +++++++++++++++++------------- org/channel-tui-state.org | 162 +++++++++++------- org/channel-tui-view.org | 329 ++++++++++++++++++------------------ 7 files changed, 1045 insertions(+), 783 deletions(-) diff --git a/docs/ROADMAP.org b/docs/ROADMAP.org index d1ac8ef..b46fde4 100644 --- a/docs/ROADMAP.org +++ b/docs/ROADMAP.org @@ -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 ~ (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. diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index 1d36a9b..825d0cd 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -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 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,8 +772,70 @@ (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 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 | /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) (cl-tty.input:defkeymap :local @@ -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))))) diff --git a/lisp/channel-tui-state.lisp b/lisp/channel-tui-state.lisp index 05cf0bc..9e425cc 100644 --- a/lisp/channel-tui-state.lisp +++ b/lisp/channel-tui-state.lisp @@ -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 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) diff --git a/lisp/channel-tui-view.lisp b/lisp/channel-tui-view.lisp index 5020e0d..46e66a2 100644 --- a/lisp/channel-tui-view.lisp +++ b/lisp/channel-tui-view.lisp @@ -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))) diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index 23b6a54..db5c6b2 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -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 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,8 +816,70 @@ 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 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 | /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) (cl-tty.input:defkeymap :local @@ -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))))) diff --git a/org/channel-tui-state.org b/org/channel-tui-state.org index 367dd91..7811d04 100644 --- a/org/channel-tui-state.org +++ b/org/channel-tui-state.org @@ -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 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 diff --git a/org/channel-tui-view.org b/org/channel-tui-view.org index 8b88ea9..896fcfe 100644 --- a/org/channel-tui-view.org +++ b/org/channel-tui-view.org @@ -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