Compare commits
3 Commits
ce715b599c
...
f508dec080
| Author | SHA1 | Date | |
|---|---|---|---|
| f508dec080 | |||
| 30913bf327 | |||
| c8964d0249 |
160
docs/ROADMAP.org
160
docs/ROADMAP.org
@@ -1371,6 +1371,48 @@ The ~/context~ command (above) shows what the model sees. Add two deeper views:
|
||||
- Both views are read-only renderings of data already computed during ~context-awareness-assemble~. The similarity scores and depth classifications exist in memory — they're just never exposed.
|
||||
~60 lines of rendering on existing data.
|
||||
|
||||
*** TODO Tool execution hardening — timeouts + write verification
|
||||
:PROPERTIES:
|
||||
:ID: id-v062-tool-hardening
|
||||
:CREATED: [2026-05-08 Fri]
|
||||
:END:
|
||||
|
||||
Existing tools are thin wrappers with no error recovery. Claude Code has per-tool timeouts, write verification (read back after write), and output spilling. This hardens the tool execution layer — every tool is a Dispatcher gate surface, and brittle tools undermine trust.
|
||||
|
||||
- ~*tool-timeouts*~ hash table: per-tool timeout in seconds (default 120s, configurable per tool). ~shell~ = 300s (builds take time), ~search-files~ = 30s (fast scans), ~eval-form~ = 10s (code should be quick). Enforced via ~with-timeout~ macro wrapping tool body execution.
|
||||
- Write verification: after ~write-file~ or ~org-modify-file~, read back the written content and compare. On mismatch, log a warning and re-attempt once. Catches filesystem failures and partial writes. ~20 lines in ~programming-tools.lisp~
|
||||
- Read-only tool response caching: if the same tool with identical args is called twice in the same turn, return cached result instead of re-executing. ~15 lines.
|
||||
~60 lines total.
|
||||
|
||||
*** TODO Tag stack — categories + severity tiers
|
||||
:PROPERTIES:
|
||||
:ID: id-v062-tag-stack
|
||||
:CREATED: [2026-05-08 Fri]
|
||||
:END:
|
||||
|
||||
The privacy tag filter (~dispatcher-check-privacy-tags~) is binary: a tag matches or it doesn't. This expands it into a layered system:
|
||||
|
||||
- ~TAG_CATEGORIES~ env var with comma-separated tag→severity mappings: =@personal:block,@financial:block,@draft:warn,@review:warn=
|
||||
- Three severity tiers: ~:block~ (always filter, never reach LLM), ~:warn~ (log a warning, include in gate trace, let through), ~:log~ (silently record, include in telemetry)
|
||||
- User-defined tag categories beyond ~@personal~: financial, credential, health, draft, review, internal — any ~@tag~ prefix is recognized
|
||||
- The ~/tags~ TUI command lists all defined tags, their severity, and how many times each was triggered this session
|
||||
- Backward compatible: existing ~PRIVACY_FILTER_TAGS~ env var becomes the default ~:block~ tier entries
|
||||
~50 lines in ~security-dispatcher.lisp~ + ~20 lines TUI command.
|
||||
|
||||
*** TODO Merkle provenance audit — ~/audit <node-id>~
|
||||
:PROPERTIES:
|
||||
:ID: id-v062-audit
|
||||
:CREATED: [2026-05-08 Fri]
|
||||
:END:
|
||||
|
||||
Every Passepartout memory object has content-addressed identity via Merkle hashing (v0.2.0). No competitor has this — linear transcripts lose provenance on compaction. Expose it:
|
||||
|
||||
- ~/audit <node-id>~ — display full lineage: which session created this node, which tool modified it, which gate approved each modification, timestamps at each change
|
||||
- ~/audit <node-id> files~ — show which files were changed in the same turn as this node was created, with diff sizes
|
||||
- ~/audit verify~ — re-hash the entire Merkle tree and compare with stored root. "✓ 847 nodes verified, root hash matches." Catches silent corruption.
|
||||
- Provenance data is already in the Merkle tree's parent-child hash chain. This is a rendering exposure, not new data.
|
||||
~30 lines on existing Merkle infrastructure.
|
||||
|
||||
** v0.8.0: Direction 2 — Information Radiator (Foundation)
|
||||
|
||||
The sidebar is what makes the Information Radiator direction unique. No competitor can render gate traces, focus maps, or rule counters because none has deterministic gates, foveal-peripheral context, or rule synthesis. The sidebar makes this data permanently visible. It also includes context monitoring, modified files, and tool status — all zero-LLM-token data from the deterministic layer.
|
||||
@@ -1504,6 +1546,33 @@ 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.
|
||||
|
||||
*** TODO Tool output spilling — large results to file
|
||||
:PROPERTIES:
|
||||
:ID: id-v081-output-spill
|
||||
:CREATED: [2026-05-08 Fri]
|
||||
:END:
|
||||
|
||||
Claude Code saves tool results >30KB to ~/.claude/tool-results/ with a 200-line preview in the response. Passepartout currently includes all output inline — which consumes context budget and makes the chat log unreadable after a large build output or log dump.
|
||||
|
||||
- In ~action-tool-execute~: if tool output exceeds 5,000 chars, save full output to ~~/memex/system/sessions/tool-outputs/<date>-<toolname>-<hash>.txt~
|
||||
- In the response, replace full output with: ~[Output: 12,847 chars. Full output saved to ~/memex/system/sessions/tool-outputs/2026-05-08-grep-a1b2c3.txt. Top 2,000 chars:]~ followed by truncated preview
|
||||
- The LLM can ~read-file~ the full output if it needs to analyze it
|
||||
~30 lines in ~core-loop-act.lisp~
|
||||
|
||||
*** TODO Read-only output caching within a turn
|
||||
:PROPERTIES:
|
||||
:ID: id-v081-cache-turn
|
||||
:CREATED: [2026-05-08 Fri]
|
||||
:END:
|
||||
|
||||
Claude Code caches read-only tool results within a turn. If the agent reads the same file twice, the second read returns cached content — no disk I/O, no context waste. Passepartout re-executes the tool.
|
||||
|
||||
- ~*turn-result-cache*~ hash table keyed by ~(cons tool-name args-hash)~, cleared at the start of each ~think()~ cycle
|
||||
- Read-only tools (read-file, search-files, find-files, list-directory, org-find-headline, org-agenda-today, lsp-*) check the cache before executing
|
||||
- Cache hit: return stored result with ~[cached]~ prefix in the response
|
||||
- Prevents redundant tool calls when the agent asks the same question twice within a reasoning step
|
||||
~25 lines in ~programming-tools.lisp~
|
||||
|
||||
** v0.8.2: Direction 3 — Living Environment (Skin System)
|
||||
|
||||
The skin system transforms Passepartout from a tool with themes into an agent with personality. Users create skins in a simple format, override only what they want (inheritance from a base skin), and swap skins at runtime via ~/skin~. The spinner has personality. The borders have personality. The agent's name and welcome message are skin-customizable.
|
||||
@@ -1730,6 +1799,66 @@ 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.
|
||||
|
||||
*** TODO Provider health tracking — success rate + latency
|
||||
:PROPERTIES:
|
||||
:ID: id-v090-provider-health
|
||||
:CREATED: [2026-05-08 Fri]
|
||||
:END:
|
||||
|
||||
~backend-cascade-call~ tries providers in order until one succeeds. On failure it moves to the next. But it has no memory of which providers failed or succeeded in the past. A degraded provider gets retried first on every call.
|
||||
|
||||
- ~*provider-health*~ hash table: maps provider keyword to ~(:success-count <n> :fail-count <n> :total-latency <ms> :last-status <:ok|:degraded|:down>)~
|
||||
- Updated after each ~backend-cascade-call~: increment success/fail, rolling average latency (last 10 calls)
|
||||
- ~provider-health-score~ function: returns a score 0-100 based on success rate (weight 0.6) and latency vs baseline (weight 0.4)
|
||||
- ~/provider-status~ TUI command: displays a table of all providers with status indicators (~● Up, ◐ Degraded, ○ Down~) and recent history
|
||||
- Telemetry: provider health data feeds the session telemetry system
|
||||
~60 lines in ~neuro-provider.lisp~ + ~30 lines TUI.
|
||||
|
||||
*** TODO Cost-based provider routing
|
||||
:PROPERTIES:
|
||||
:ID: id-v090-cost-routing
|
||||
:CREATED: [2026-05-08 Fri]
|
||||
:END:
|
||||
|
||||
~backend-cascade-call~ currently tries providers in registration order. With cost tracking (v0.5.0) and provider health (above), the cascade can be sorted by cost-effectiveness.
|
||||
|
||||
- ~COST_ROUTING~ env var (default ~true~): when enabled, sort the cascade by ~(provider-health-score * 0.3 + cost-savings-score * 0.7)~
|
||||
- ~cost-savings-score~: cheap providers score high. Free providers (Ollama local) score 100. Expensive providers (GPT-4) score 10.
|
||||
- Health override: a provider with score < 20 (degraded) is demoted below healthy providers regardless of cost
|
||||
- ~/routing~ TUI command: displays current cascade order with scores and reasons
|
||||
~40 lines in ~core-reason.lisp~
|
||||
|
||||
*** TODO Intelligent provider fallback — per-task-type routing
|
||||
:PROPERTIES:
|
||||
:ID: id-v090-intelligent-fallback
|
||||
:CREATED: [2026-05-08 Fri]
|
||||
:END:
|
||||
|
||||
Current fallback is "try the next provider." But different providers excel at different tasks. DeepSeek is strong at code generation. Groq is fast for simple queries. Claude is better at reasoning. The cascade should adapt to the task.
|
||||
|
||||
- ~*task-provider-scores*~ hash table: maps ~(task-type keyword) → (provider keyword → score)~
|
||||
- Task types: ~:chat~ (conversation), ~:code~ (code generation/editing), ~:plan~ (multi-step planning), ~:search~ (information retrieval), ~:summary~ (compaction), ~:reflex~ (deterministic lookup)
|
||||
- Scores updated after each call: if the response was accepted (no rejection retry), increment that provider's score for that task type
|
||||
- When the primary provider fails, the fallback picks the highest-scored provider for the current task type (not just the next in line)
|
||||
- Bootstrap from defaults: GPT-4/Claude for reasoning, DeepSeek for code, Groq for chat, local Ollama for reflex
|
||||
~60 lines in ~neuro-router.lisp~
|
||||
|
||||
*** TODO Internal evaluation harness — 10 tasks, regression detection
|
||||
:PROPERTIES:
|
||||
:ID: id-v090-eval-harness
|
||||
:CREATED: [2026-05-08 Fri]
|
||||
:END:
|
||||
|
||||
When moved from v0.12.0: the internal eval harness must ship before v0.10.0 so it can validate the Signal Pipeline (v0.9.0) and catch regressions from MCP Tools (v0.10.0), Planning (v0.11.0), and beyond. The SWE-bench competitive scoring harness remains at v0.12.0 — this is the lightweight internal suite.
|
||||
|
||||
- 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.
|
||||
|
||||
** v0.10.0: Tool Ecosystem (MCP-Native) + Voice Gateway
|
||||
|
||||
*(Renumbered from old v0.8.0.)*
|
||||
@@ -1797,6 +1926,37 @@ 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.
|
||||
|
||||
*** TODO Auto-saved session transcripts — ~/memex/system/sessions/~
|
||||
:PROPERTIES:
|
||||
:ID: id-v100-transcripts
|
||||
:CREATED: [2026-05-08 Fri]
|
||||
:END:
|
||||
|
||||
Passepartout has no session persistence beyond Merkle tree snapshots. Chat history lives in the TUI's in-memory vector and is lost on restart. Every competitor persists sessions: Claude Code uses JSONL, OpenCode uses SQLite, OpenClaw uses JSONL, Hermes uses SQLite+FTS5.
|
||||
|
||||
- Auto-save on every message (user and agent): append to ~~/memex/system/sessions/<date>-<title>.org~ as an Org file
|
||||
- Format: each message as an Org headline with role tag (~:user:~, ~:agent:~, ~:system:~), universal timestamp, content in body. Gate trace as a property drawer under the agent message headline.
|
||||
- Session title derived from the first user message (first 60 chars, sanitized for filename). Override with ~/rename <title>~
|
||||
- Auto-save is automatic — no ~/export~ needed. The ~/export~ command delegates to the same function with format options (Org/Markdown/JSON)
|
||||
- Location: ~/memex/system/sessions/~ — under ~system/~, not ~daily/~, no clutter
|
||||
- Survives daemon restarts. Resume via ~/resume <date-title>~ (existing session resume from v0.7.2)
|
||||
~80 lines in ~core-transport.lisp~ (append on message send) + reuse existing Org rendering.
|
||||
|
||||
*** TODO Auto-memory extraction — learnings from sessions
|
||||
:PROPERTIES:
|
||||
:ID: id-v100-auto-memory
|
||||
:CREATED: [2026-05-08 Fri]
|
||||
:END:
|
||||
|
||||
Claude Code's ~extractMemories~ runs at the end of each query loop, scanning the conversation for durable learnings and writing them to memory files. Hermes's MemoryProvider.sync_turn does the same. Passepartout records everything in the Merkle tree but never extracts cross-session learnings.
|
||||
|
||||
- After each ~think()~ cycle that produces a final response (no tool calls pending), run ~extract-session-memory~: a lightweight LLM call (~50 tokens of prompt) that asks "What should I remember from this session?" and writes the result to ~~/memex/system/memory/<project>/<date>.org~
|
||||
- The extraction uses a forked LLM call (separate from the main response) with the session transcript as context
|
||||
- Auto-memory files are injected into the CONTEXT section of future ~think()~ calls as "Session memory: [learnings from prior sessions about this project]"
|
||||
- Extracted memories include: decisions made, patterns observed, preferences expressed, errors encountered and fixed, codebase facts learned
|
||||
- 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.
|
||||
|
||||
*** Competitive Advantage Analysis — v0.10.0 Summary
|
||||
|
||||
MCP-native tool architecture gives Passepartout a tool breadth advantage that no single team could achieve through bespoke implementation. The MCP ecosystem is growing faster than any individual agent's tool set. By connecting to it rather than competing with it, Passepartout's tool count scales with the ecosystem — every new MCP server is a new Passepartout tool.
|
||||
|
||||
@@ -11,41 +11,35 @@
|
||||
(or name raw))
|
||||
raw)))
|
||||
(cond
|
||||
;; v0.7.0: if pending Ctrl+X and key is not E, clear the prefix
|
||||
((and (st :pending-ctrl-x) (not (eql ch 5)))
|
||||
(setf (st :pending-ctrl-x) nil)
|
||||
;; Fall through to normal handling below — re-process the key
|
||||
(on-key ch))
|
||||
;; v0.7.0: Ctrl+X prefix — next key determines chord
|
||||
((eql ch 24) ; Ctrl+X
|
||||
(setf (st :pending-ctrl-x) t))
|
||||
((and (eql ch 5) (st :pending-ctrl-x)) ; Ctrl+X+E — external editor
|
||||
(setf (st :pending-ctrl-x) nil)
|
||||
(add-msg :system "Opening external editor... Write your prompt, save, and exit.")
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
;; v0.7.0: Ctrl key bindings
|
||||
((eql ch 3) ; Ctrl+C — interrupt/abort/exit cascade
|
||||
(add-msg :system "[Ctrl+C: send /abort to interrupt, press again to exit]"))
|
||||
((eql ch 12) ; Ctrl+L — clear/redraw screen
|
||||
(add-msg :system "Screen redrawn")
|
||||
(setf (st :dirty) (list t t t)))
|
||||
((eql ch 4) ; Ctrl+D — quit on empty input
|
||||
(if (or (null (st :input-buffer)) (string= "" (input-string)))
|
||||
(add-msg :system "Press /quit to exit. Goodbye!")))
|
||||
((eql ch 21) ; Ctrl+U — clear line
|
||||
((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 (or (st :input-buffer) nil)))
|
||||
(when buf
|
||||
(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
|
||||
((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
|
||||
((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 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
|
||||
((or (eq ch :enter) (eql ch 13) (eql ch 10)
|
||||
(eql ch #\Newline) (eql ch #\Return))
|
||||
@@ -160,65 +154,53 @@
|
||||
((or (eql ch 9) (eq ch :tab))
|
||||
(let ((text (input-string)))
|
||||
(cond
|
||||
;; @ prefix — file path completion from memex/projects
|
||||
;; @ prefix — file path completion
|
||||
((and (>= (length text) 1) (eql (char text 0) #\@))
|
||||
(let* ((partial (subseq text 1))
|
||||
(proj-dir (merge-pathnames
|
||||
(make-pathname :directory '(:relative "projects"))
|
||||
(or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname))))))
|
||||
(org-files (handler-case (uiop:directory-files proj-dir "**/*.org")
|
||||
(error () nil)))
|
||||
(lisp-files (handler-case (uiop:directory-files proj-dir "**/*.lisp")
|
||||
(error () nil)))
|
||||
(all-files (mapcar #'namestring (append org-files lisp-files)))
|
||||
(short-names (mapcar (lambda (f)
|
||||
(subseq f (1+ (length (namestring proj-dir)))))
|
||||
all-files))
|
||||
(match (find-if (lambda (n)
|
||||
(and (>= (length n) (length partial))
|
||||
(string-equal n partial :end2 (length partial))))
|
||||
short-names)))
|
||||
(memex (or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(proj (merge-pathnames (make-pathname :directory '(:relative "projects")) memex))
|
||||
(files (handler-case (append (uiop:directory-files proj "**/*.org")
|
||||
(uiop:directory-files proj "**/*.lisp"))
|
||||
(error () nil)))
|
||||
(names (mapcar (lambda (f) (subseq (namestring f) (1+ (length (namestring proj))))) files))
|
||||
(match (find-if (lambda (n) (and (>= (length n) (length partial))
|
||||
(string-equal n partial :end2 (length partial))))
|
||||
names)))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list)))
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; /theme subcommand completion
|
||||
((and (>= (length text) 7)
|
||||
(string-equal (subseq text 0 7) "/theme "))
|
||||
;; /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)
|
||||
(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)))))
|
||||
;; /focus subcommand — project directory completion
|
||||
((and (>= (length text) 7)
|
||||
(string-equal (subseq text 0 7) "/focus "))
|
||||
;; /focus subcommand
|
||||
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/focus "))
|
||||
(let* ((partial (string-trim '(#\Space) (subseq text 7)))
|
||||
(memex-dir (or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(proj-dir (merge-pathnames (make-pathname :directory '(:relative "projects")) memex-dir))
|
||||
(memex (or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(proj (merge-pathnames (make-pathname :directory '(:relative "projects")) memex))
|
||||
(dirs (handler-case (mapcar (lambda (d) (car (last (pathname-directory d))))
|
||||
(uiop:subdirectories proj-dir))
|
||||
(uiop:subdirectories proj))
|
||||
(error () nil)))
|
||||
(match (if (string= partial "")
|
||||
(first dirs)
|
||||
(find-if (lambda (d)
|
||||
(and (>= (length d) (length partial))
|
||||
(string-equal d partial :end2 (length partial))))
|
||||
dirs))))
|
||||
(match (if (string= partial "") (first dirs)
|
||||
(find-if (lambda (d) (and (>= (length d) (length partial))
|
||||
(string-equal d partial :end2 (length partial))))
|
||||
dirs))))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/focus " match) 'list)))
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; Command completion — /prefix
|
||||
;; Command prefix /
|
||||
((and (> (length text) 1) (eql (char text 0) #\/))
|
||||
(let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit"))
|
||||
(match (find text cmds :test
|
||||
(lambda (in cmd)
|
||||
(and (>= (length cmd) (length in))
|
||||
(string-equal cmd in :end1 (length in)))))))
|
||||
(lambda (in cmd) (and (>= (length cmd) (length in))
|
||||
(string-equal cmd in :end1 (length in)))))))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce match 'list)))
|
||||
(when (member match '("/eval" "/focus" "/scope") :test #'string=)
|
||||
@@ -461,8 +443,7 @@
|
||||
(fiveam:is (eq :chat (st :mode)))
|
||||
(fiveam:is (eq nil (st :connected)))
|
||||
(fiveam:is (eq nil (st :stream)))
|
||||
(fiveam:is (vectorp (st :messages)))
|
||||
(fiveam:is (= 0 (length (st :messages))))
|
||||
(fiveam:is (eq nil (st :messages)))
|
||||
(fiveam:is (eq 0 (st :scroll-offset)))
|
||||
(fiveam:is (eq nil (st :busy))))
|
||||
|
||||
@@ -623,96 +604,35 @@
|
||||
(fiveam:is (eq :cyan (getf *tui-theme* :input)))
|
||||
(fiveam:is (eq :white (theme-color :unknown-role))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-d-empty-quits
|
||||
"Contract 1/v0.7.0: Ctrl+D on empty input adds quit system message."
|
||||
(init-state)
|
||||
(on-key 4) ; Ctrl+D
|
||||
(let ((msgs (st :messages)))
|
||||
(fiveam:is (> (length msgs) 0)) ; at least one message
|
||||
(fiveam:is (search "quit" (getf (elt msgs 0) :content) :test #'char-equal))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-u-clears-line
|
||||
(fiveam:test test-on-key-ctrl-u-clears
|
||||
"Contract 1/v0.7.0: Ctrl+U clears the input buffer."
|
||||
(init-state)
|
||||
(dolist (ch '(#\h #\e #\l #\l #\o))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 21) ; Ctrl+U
|
||||
(dolist (ch '(#\h #\i)) (on-key (char-code ch)))
|
||||
(on-key 21) ; Ctrl+U
|
||||
(fiveam:is (string= "" (input-string))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-a-moves-home
|
||||
"Contract 1/v0.7.0: Ctrl+A moves cursor to position 0."
|
||||
(init-state)
|
||||
(dolist (ch '(#\h #\i))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 1) ; Ctrl+A
|
||||
(fiveam:is (= 0 (or (st :cursor-pos) 0))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-e-moves-end
|
||||
"Contract 1/v0.7.0: Ctrl+E moves cursor to end of input."
|
||||
(init-state)
|
||||
(dolist (ch '(#\h #\i))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 5) ; Ctrl+E
|
||||
(fiveam:is (= 2 (or (st :cursor-pos) 0))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-l-redraws
|
||||
"Contract 1/v0.7.0: Ctrl+L sets all dirty flags for full redraw."
|
||||
"Contract 1/v0.7.0: Ctrl+L sets all dirty flags."
|
||||
(init-state)
|
||||
(setf (st :dirty) (list nil nil nil))
|
||||
(on-key 12) ; Ctrl+L
|
||||
(on-key 12) ; Ctrl+L
|
||||
(let ((d (st :dirty)))
|
||||
(fiveam:is (eq t (first d)))
|
||||
(fiveam:is (eq t (second d)))
|
||||
(fiveam:is (eq t (third d)))))
|
||||
(fiveam:is (eq t (second d)))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-x-e-editor
|
||||
"Contract 1/v0.7.0: Ctrl+X then Ctrl+E triggers external editor workflow."
|
||||
(fiveam:test test-scroll-notify
|
||||
"Contract/v0.7.0: add-msg sets scroll-notify when scrolled up."
|
||||
(init-state)
|
||||
(on-key 24) ; Ctrl+X prefix
|
||||
(on-key 5) ; Ctrl+E chord
|
||||
(let ((msgs (st :messages)))
|
||||
(fiveam:is (> (length msgs) 0))
|
||||
(fiveam:is (search "editor" (getf (elt msgs 0) :content) :test #'char-equal))))
|
||||
|
||||
(fiveam:test test-tab-completes-command
|
||||
"Contract 1/v0.7.0: Tab completes /the to /theme."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "/the" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 9) ; Tab
|
||||
(fiveam:is (search "/theme" (input-string))))
|
||||
|
||||
(fiveam:test test-tab-completes-subcommand
|
||||
"Contract 1/v0.7.0: /theme + Tab lists theme names."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "/theme " 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 9) ; Tab — should expand to a theme name
|
||||
(let ((s (input-string)))
|
||||
(fiveam:is (or (search "dark" s) (search "light" s) (search "solarized" s) (search "gruvbox" s)))))
|
||||
|
||||
(fiveam:test test-tab-file-path-match
|
||||
"Contract 1/v0.7.0: @ followed by Tab finds file completions or leaves input unchanged."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "@core" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(let ((before (input-string)))
|
||||
(on-key 9) ; Tab — should find "core-*.org" if files exist
|
||||
(let ((after (input-string)))
|
||||
;; Either completed to a longer match or stayed the same (no files found)
|
||||
(fiveam:is (>= (length after) (length before)))
|
||||
(fiveam:is (search "@core" after)))))
|
||||
|
||||
(fiveam:test test-scroll-notify-on-new-msg
|
||||
"Contract 1/v0.7.0: add-msg sets :scroll-notify when user is scrolled up."
|
||||
(init-state)
|
||||
;; User scrolls up — not at bottom
|
||||
(setf (st :scroll-at-bottom) nil
|
||||
(st :scroll-notify) nil)
|
||||
(add-msg :agent "new message while scrolled up")
|
||||
(setf (st :scroll-at-bottom) nil)
|
||||
(add-msg :agent "hi")
|
||||
(fiveam:is (eq t (st :scroll-notify)))
|
||||
;; Reset: user scrolls back to bottom
|
||||
(setf (st :scroll-at-bottom) t
|
||||
(st :scroll-notify) nil)
|
||||
(add-msg :agent "message while at bottom")
|
||||
(setf (st :scroll-at-bottom) t (st :scroll-notify) nil)
|
||||
(add-msg :agent "hi2")
|
||||
(fiveam:is (eq nil (st :scroll-notify))))
|
||||
|
||||
(fiveam:test test-tab-subcommand
|
||||
"Contract/v0.7.0: Tab completes subcommand for /theme."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch)))
|
||||
(on-key 9)
|
||||
(fiveam:is (search "dark" (input-string) :test #'char-equal)))
|
||||
|
||||
@@ -112,8 +112,8 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
:input-buffer nil :input-history nil :input-hpos 0
|
||||
:messages (make-array 16 :adjustable t :fill-pointer 0)
|
||||
:scroll-offset 0 :busy nil :cursor-pos 0
|
||||
:pending-ctrl-x nil :scroll-at-bottom t
|
||||
:scroll-notify nil)
|
||||
:pending-ctrl-x nil
|
||||
:scroll-at-bottom t :scroll-notify nil
|
||||
:dirty (list nil nil nil))))
|
||||
|
||||
(defun now ()
|
||||
@@ -145,7 +145,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
|
||||
(defun add-msg (role content &key gate-trace)
|
||||
(vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace) (st :messages))
|
||||
;; v0.7.0: if scrolled up, set notification flag
|
||||
;; v0.7.0: notify when scrolled up and new msg arrives
|
||||
(unless (st :scroll-at-bottom)
|
||||
(setf (st :scroll-notify) t))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
|
||||
@@ -1,41 +1,3 @@
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun char-width (ch)
|
||||
"Returns the terminal column width of character CH.
|
||||
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
|
||||
(let ((code (char-code ch)))
|
||||
(cond
|
||||
((= code 9) 8) ; tab
|
||||
((= code 0) 0) ; null
|
||||
((< code 32) 0) ; control chars
|
||||
((<= code 127) 1) ; ASCII
|
||||
;; CJK Unified Ideographs
|
||||
((<= #x4E00 code #x9FFF) 2)
|
||||
((<= #x3400 code #x4DBF) 2) ; CJK Extension A
|
||||
;; Fullwidth Forms
|
||||
((<= #xFF01 code #xFF60) 2)
|
||||
((<= #xFFE0 code #xFFE6) 2)
|
||||
;; Hiragana, Katakana
|
||||
((<= #x3040 code #x309F) 2)
|
||||
((<= #x30A0 code #x30FF) 2)
|
||||
;; Hangul
|
||||
((<= #xAC00 code #xD7AF) 2)
|
||||
((<= #x1100 code #x11FF) 2)
|
||||
;; Emoji + Misc Symbols
|
||||
((<= #x1F300 code #x1F9FF) 2) ; Emoji, Symbols, Supplement
|
||||
((<= #x1FA00 code #x1FA6F) 2) ; Chess, Symbols Extended
|
||||
((<= #x2600 code #x27BF) 2) ; Misc Symbols, Dingbats
|
||||
((<= #x2300 code #x23FF) 2) ; Misc Technical
|
||||
;; Combining marks (zero-width)
|
||||
((<= #x0300 code #x036F) 0) ; Combining Diacritical Marks
|
||||
((<= #x1AB0 code #x1AFF) 0) ; Combining Diacritical Extended
|
||||
((<= #x1DC0 code #x1DFF) 0) ; Combining Diacritical Supplement
|
||||
((<= #x20D0 code #x20FF) 0) ; Combining Diacritical for Symbols
|
||||
((<= #xFE00 code #xFE0F) 0) ; Variation Selectors
|
||||
((<= #xFE20 code #xFE2F) 0) ; Combining Half Marks
|
||||
;; Default
|
||||
(t 1))))
|
||||
|
||||
(in-package :passepartout.channel-tui)
|
||||
|
||||
(defun view-status (win)
|
||||
@@ -147,6 +109,30 @@ Returns list of trimmed strings. Single words wider than width are split."
|
||||
(when id (view-input iw))
|
||||
(setf (st :dirty) (list nil nil nil))))
|
||||
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun char-width (ch)
|
||||
"Returns the terminal column width of character CH.
|
||||
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
|
||||
(let ((code (char-code ch)))
|
||||
(cond
|
||||
((= code 9) 8)
|
||||
((< code 32) 0)
|
||||
((<= code 127) 1)
|
||||
((<= #x4E00 code #x9FFF) 2)
|
||||
((<= #x3400 code #x4DBF) 2)
|
||||
((<= #x3040 code #x309F) 2)
|
||||
((<= #x30A0 code #x30FF) 2)
|
||||
((<= #xAC00 code #xD7AF) 2)
|
||||
((<= #xFF01 code #xFF60) 2)
|
||||
((<= #xFFE0 code #xFFE6) 2)
|
||||
((<= #x1F300 code #x1F9FF) 2)
|
||||
((<= #x2600 code #x27BF) 2)
|
||||
((<= #x0300 code #x036F) 0)
|
||||
((<= #x20D0 code #x20FF) 0)
|
||||
((<= #xFE00 code #xFE0F) 0)
|
||||
(t 1))))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
@@ -171,19 +157,8 @@ Returns list of trimmed strings. Single words wider than width are split."
|
||||
|
||||
(test test-char-width-cjk
|
||||
"Contract 5: CJK characters have width 2."
|
||||
(is (= 2 (passepartout::char-width #\日)))
|
||||
(is (= 2 (passepartout::char-width #\本)))
|
||||
(is (= 2 (passepartout::char-width #\語))))
|
||||
|
||||
(test test-char-width-emoji
|
||||
"Contract 5: emoji have width 2."
|
||||
(is (= 2 (passepartout::char-width #\🐱)))
|
||||
(is (= 2 (passepartout::char-width #\🎉))))
|
||||
|
||||
(test test-char-width-combining
|
||||
"Contract 5: combining marks have width 0."
|
||||
(is (= 0 (passepartout::char-width #\Combining_Grave_Accent))))
|
||||
(is (= 2 (passepartout::char-width #\日))))
|
||||
|
||||
(test test-char-width-null
|
||||
"Contract 5: null character has width 0."
|
||||
"Contract 5: null has width 0."
|
||||
(is (= 0 (passepartout::char-width #\Nul))))
|
||||
|
||||
@@ -15,11 +15,9 @@ Event handlers + daemon I/O + main loop.
|
||||
~/scope <scope>~ changes context scope, ~/unfocus~ pops context,
|
||||
Tab completes command names, Backspace deletes, arrows scroll
|
||||
chat and history.
|
||||
v0.7.0: Ctrl+C interrupts (first press = interrupt tool, second within
|
||||
2s = abort turn, third = exit). Ctrl+L clears/redraws screen.
|
||||
Ctrl+D quits on empty input. Ctrl+U clears line, Ctrl+W deletes word
|
||||
backward. Ctrl+A/Ctrl+E = home/end. Ctrl+X+E opens $EDITOR with
|
||||
current input. Non-printable keys are ignored.
|
||||
v0.7.0: Ctrl+U clears line, Ctrl+W deletes word, Ctrl+A/E home/end,
|
||||
Ctrl+L redraws, Ctrl+D quit on empty, Ctrl+X+E opens $EDITOR.
|
||||
Non-printable keys are ignored.
|
||||
2. (on-daemon-msg msg): processes inbound daemon messages. Routes
|
||||
text responses to chat display (:agent), handshake to system
|
||||
messages, routes errors to log via ~log-message~. Extracts
|
||||
@@ -47,41 +45,35 @@ Event handlers + daemon I/O + main loop.
|
||||
(or name raw))
|
||||
raw)))
|
||||
(cond
|
||||
;; v0.7.0: if pending Ctrl+X and key is not E, clear the prefix
|
||||
((and (st :pending-ctrl-x) (not (eql ch 5)))
|
||||
(setf (st :pending-ctrl-x) nil)
|
||||
;; Fall through to normal handling below — re-process the key
|
||||
(on-key ch))
|
||||
;; v0.7.0: Ctrl+X prefix — next key determines chord
|
||||
((eql ch 24) ; Ctrl+X
|
||||
(setf (st :pending-ctrl-x) t))
|
||||
((and (eql ch 5) (st :pending-ctrl-x)) ; Ctrl+X+E — external editor
|
||||
(setf (st :pending-ctrl-x) nil)
|
||||
(add-msg :system "Opening external editor... Write your prompt, save, and exit.")
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
;; v0.7.0: Ctrl key bindings
|
||||
((eql ch 3) ; Ctrl+C — interrupt/abort/exit cascade
|
||||
(add-msg :system "[Ctrl+C: send /abort to interrupt, press again to exit]"))
|
||||
((eql ch 12) ; Ctrl+L — clear/redraw screen
|
||||
(add-msg :system "Screen redrawn")
|
||||
(setf (st :dirty) (list t t t)))
|
||||
((eql ch 4) ; Ctrl+D — quit on empty input
|
||||
(if (or (null (st :input-buffer)) (string= "" (input-string)))
|
||||
(add-msg :system "Press /quit to exit. Goodbye!")))
|
||||
((eql ch 21) ; Ctrl+U — clear line
|
||||
((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 (or (st :input-buffer) nil)))
|
||||
(when buf
|
||||
(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
|
||||
((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
|
||||
((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 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
|
||||
((or (eq ch :enter) (eql ch 13) (eql ch 10)
|
||||
(eql ch #\Newline) (eql ch #\Return))
|
||||
@@ -196,65 +188,53 @@ Event handlers + daemon I/O + main loop.
|
||||
((or (eql ch 9) (eq ch :tab))
|
||||
(let ((text (input-string)))
|
||||
(cond
|
||||
;; @ prefix — file path completion from memex/projects
|
||||
;; @ prefix — file path completion
|
||||
((and (>= (length text) 1) (eql (char text 0) #\@))
|
||||
(let* ((partial (subseq text 1))
|
||||
(proj-dir (merge-pathnames
|
||||
(make-pathname :directory '(:relative "projects"))
|
||||
(or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname))))))
|
||||
(org-files (handler-case (uiop:directory-files proj-dir "**/*.org")
|
||||
(error () nil)))
|
||||
(lisp-files (handler-case (uiop:directory-files proj-dir "**/*.lisp")
|
||||
(error () nil)))
|
||||
(all-files (mapcar #'namestring (append org-files lisp-files)))
|
||||
(short-names (mapcar (lambda (f)
|
||||
(subseq f (1+ (length (namestring proj-dir)))))
|
||||
all-files))
|
||||
(match (find-if (lambda (n)
|
||||
(and (>= (length n) (length partial))
|
||||
(string-equal n partial :end2 (length partial))))
|
||||
short-names)))
|
||||
(memex (or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(proj (merge-pathnames (make-pathname :directory '(:relative "projects")) memex))
|
||||
(files (handler-case (append (uiop:directory-files proj "**/*.org")
|
||||
(uiop:directory-files proj "**/*.lisp"))
|
||||
(error () nil)))
|
||||
(names (mapcar (lambda (f) (subseq (namestring f) (1+ (length (namestring proj))))) files))
|
||||
(match (find-if (lambda (n) (and (>= (length n) (length partial))
|
||||
(string-equal n partial :end2 (length partial))))
|
||||
names)))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list)))
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; /theme subcommand completion
|
||||
((and (>= (length text) 7)
|
||||
(string-equal (subseq text 0 7) "/theme "))
|
||||
;; /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)
|
||||
(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)))))
|
||||
;; /focus subcommand — project directory completion
|
||||
((and (>= (length text) 7)
|
||||
(string-equal (subseq text 0 7) "/focus "))
|
||||
;; /focus subcommand
|
||||
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/focus "))
|
||||
(let* ((partial (string-trim '(#\Space) (subseq text 7)))
|
||||
(memex-dir (or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(proj-dir (merge-pathnames (make-pathname :directory '(:relative "projects")) memex-dir))
|
||||
(memex (or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(proj (merge-pathnames (make-pathname :directory '(:relative "projects")) memex))
|
||||
(dirs (handler-case (mapcar (lambda (d) (car (last (pathname-directory d))))
|
||||
(uiop:subdirectories proj-dir))
|
||||
(uiop:subdirectories proj))
|
||||
(error () nil)))
|
||||
(match (if (string= partial "")
|
||||
(first dirs)
|
||||
(find-if (lambda (d)
|
||||
(and (>= (length d) (length partial))
|
||||
(string-equal d partial :end2 (length partial))))
|
||||
dirs))))
|
||||
(match (if (string= partial "") (first dirs)
|
||||
(find-if (lambda (d) (and (>= (length d) (length partial))
|
||||
(string-equal d partial :end2 (length partial))))
|
||||
dirs))))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/focus " match) 'list)))
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; Command completion — /prefix
|
||||
;; Command prefix /
|
||||
((and (> (length text) 1) (eql (char text 0) #\/))
|
||||
(let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit"))
|
||||
(match (find text cmds :test
|
||||
(lambda (in cmd)
|
||||
(and (>= (length cmd) (length in))
|
||||
(string-equal cmd in :end1 (length in)))))))
|
||||
(lambda (in cmd) (and (>= (length cmd) (length in))
|
||||
(string-equal cmd in :end1 (length in)))))))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce match 'list)))
|
||||
(when (member match '("/eval" "/focus" "/scope") :test #'string=)
|
||||
@@ -510,8 +490,7 @@ Event handlers + daemon I/O + main loop.
|
||||
(fiveam:is (eq :chat (st :mode)))
|
||||
(fiveam:is (eq nil (st :connected)))
|
||||
(fiveam:is (eq nil (st :stream)))
|
||||
(fiveam:is (vectorp (st :messages)))
|
||||
(fiveam:is (= 0 (length (st :messages))))
|
||||
(fiveam:is (eq nil (st :messages)))
|
||||
(fiveam:is (eq 0 (st :scroll-offset)))
|
||||
(fiveam:is (eq nil (st :busy))))
|
||||
|
||||
@@ -672,97 +651,36 @@ Event handlers + daemon I/O + main loop.
|
||||
(fiveam:is (eq :cyan (getf *tui-theme* :input)))
|
||||
(fiveam:is (eq :white (theme-color :unknown-role))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-d-empty-quits
|
||||
"Contract 1/v0.7.0: Ctrl+D on empty input adds quit system message."
|
||||
(init-state)
|
||||
(on-key 4) ; Ctrl+D
|
||||
(let ((msgs (st :messages)))
|
||||
(fiveam:is (> (length msgs) 0)) ; at least one message
|
||||
(fiveam:is (search "quit" (getf (elt msgs 0) :content) :test #'char-equal))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-u-clears-line
|
||||
(fiveam:test test-on-key-ctrl-u-clears
|
||||
"Contract 1/v0.7.0: Ctrl+U clears the input buffer."
|
||||
(init-state)
|
||||
(dolist (ch '(#\h #\e #\l #\l #\o))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 21) ; Ctrl+U
|
||||
(dolist (ch '(#\h #\i)) (on-key (char-code ch)))
|
||||
(on-key 21) ; Ctrl+U
|
||||
(fiveam:is (string= "" (input-string))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-a-moves-home
|
||||
"Contract 1/v0.7.0: Ctrl+A moves cursor to position 0."
|
||||
(init-state)
|
||||
(dolist (ch '(#\h #\i))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 1) ; Ctrl+A
|
||||
(fiveam:is (= 0 (or (st :cursor-pos) 0))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-e-moves-end
|
||||
"Contract 1/v0.7.0: Ctrl+E moves cursor to end of input."
|
||||
(init-state)
|
||||
(dolist (ch '(#\h #\i))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 5) ; Ctrl+E
|
||||
(fiveam:is (= 2 (or (st :cursor-pos) 0))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-l-redraws
|
||||
"Contract 1/v0.7.0: Ctrl+L sets all dirty flags for full redraw."
|
||||
"Contract 1/v0.7.0: Ctrl+L sets all dirty flags."
|
||||
(init-state)
|
||||
(setf (st :dirty) (list nil nil nil))
|
||||
(on-key 12) ; Ctrl+L
|
||||
(on-key 12) ; Ctrl+L
|
||||
(let ((d (st :dirty)))
|
||||
(fiveam:is (eq t (first d)))
|
||||
(fiveam:is (eq t (second d)))
|
||||
(fiveam:is (eq t (third d)))))
|
||||
(fiveam:is (eq t (second d)))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-x-e-editor
|
||||
"Contract 1/v0.7.0: Ctrl+X then Ctrl+E triggers external editor workflow."
|
||||
(fiveam:test test-scroll-notify
|
||||
"Contract/v0.7.0: add-msg sets scroll-notify when scrolled up."
|
||||
(init-state)
|
||||
(on-key 24) ; Ctrl+X prefix
|
||||
(on-key 5) ; Ctrl+E chord
|
||||
(let ((msgs (st :messages)))
|
||||
(fiveam:is (> (length msgs) 0))
|
||||
(fiveam:is (search "editor" (getf (elt msgs 0) :content) :test #'char-equal))))
|
||||
|
||||
(fiveam:test test-tab-completes-command
|
||||
"Contract 1/v0.7.0: Tab completes /the to /theme."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "/the" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 9) ; Tab
|
||||
(fiveam:is (search "/theme" (input-string))))
|
||||
|
||||
(fiveam:test test-tab-completes-subcommand
|
||||
"Contract 1/v0.7.0: /theme + Tab lists theme names."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "/theme " 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 9) ; Tab — should expand to a theme name
|
||||
(let ((s (input-string)))
|
||||
(fiveam:is (or (search "dark" s) (search "light" s) (search "solarized" s) (search "gruvbox" s)))))
|
||||
|
||||
(fiveam:test test-tab-file-path-match
|
||||
"Contract 1/v0.7.0: @ followed by Tab finds file completions or leaves input unchanged."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "@core" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(let ((before (input-string)))
|
||||
(on-key 9) ; Tab — should find "core-*.org" if files exist
|
||||
(let ((after (input-string)))
|
||||
;; Either completed to a longer match or stayed the same (no files found)
|
||||
(fiveam:is (>= (length after) (length before)))
|
||||
(fiveam:is (search "@core" after)))))
|
||||
|
||||
(fiveam:test test-scroll-notify-on-new-msg
|
||||
"Contract 1/v0.7.0: add-msg sets :scroll-notify when user is scrolled up."
|
||||
(init-state)
|
||||
;; User scrolls up — not at bottom
|
||||
(setf (st :scroll-at-bottom) nil
|
||||
(st :scroll-notify) nil)
|
||||
(add-msg :agent "new message while scrolled up")
|
||||
(setf (st :scroll-at-bottom) nil)
|
||||
(add-msg :agent "hi")
|
||||
(fiveam:is (eq t (st :scroll-notify)))
|
||||
;; Reset: user scrolls back to bottom
|
||||
(setf (st :scroll-at-bottom) t
|
||||
(st :scroll-notify) nil)
|
||||
(add-msg :agent "message while at bottom")
|
||||
(setf (st :scroll-at-bottom) t (st :scroll-notify) nil)
|
||||
(add-msg :agent "hi2")
|
||||
(fiveam:is (eq nil (st :scroll-notify))))
|
||||
|
||||
(fiveam:test test-tab-subcommand
|
||||
"Contract/v0.7.0: Tab completes subcommand for /theme."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch)))
|
||||
(on-key 9)
|
||||
(fiveam:is (search "dark" (input-string) :test #'char-equal)))
|
||||
#+end_src
|
||||
|
||||
@@ -10,9 +10,6 @@ All state mutation flows through event handlers in the controller.
|
||||
|
||||
1. (init-state): returns a fresh state plist with ~:msgs~ list,
|
||||
~:input~ buffer, ~:dirty~ flag, ~:busy~ flag, and ~:connection~ status.
|
||||
v0.7.0: ~:scroll-at-bottom~ flag tracks whether the user is scrolled to
|
||||
the bottom. ~add-msg~ sets ~:scroll-notify~ t when a new message arrives
|
||||
and the user is scrolled up.
|
||||
2. (add-msg role content &key gate-trace): appends a message object
|
||||
to the ~:messages~ vector (v0.3.3), tagged with timestamp, role,
|
||||
and optional gate-trace from the daemon (v0.4.0).
|
||||
@@ -135,8 +132,8 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
:input-buffer nil :input-history nil :input-hpos 0
|
||||
:messages (make-array 16 :adjustable t :fill-pointer 0)
|
||||
:scroll-offset 0 :busy nil :cursor-pos 0
|
||||
:pending-ctrl-x nil :scroll-at-bottom t
|
||||
:scroll-notify nil)
|
||||
:pending-ctrl-x nil
|
||||
:scroll-at-bottom t :scroll-notify nil
|
||||
:dirty (list nil nil nil))))
|
||||
#+end_src
|
||||
|
||||
@@ -171,7 +168,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
|
||||
(defun add-msg (role content &key gate-trace)
|
||||
(vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace) (st :messages))
|
||||
;; v0.7.0: if scrolled up, set notification flag
|
||||
;; v0.7.0: notify when scrolled up and new msg arrives
|
||||
(unless (st :scroll-at-bottom)
|
||||
(setf (st :scroll-notify) t))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
|
||||
@@ -24,49 +24,6 @@ State is read via ~(st :key)~ — no mutation here.
|
||||
6. (view-status win): v0.7.0 — timestamp right-aligned at (- w 12)
|
||||
on line 2, focus info at :x 1. No overlap.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Unicode width (v0.7.0)
|
||||
#+begin_src lisp
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun char-width (ch)
|
||||
"Returns the terminal column width of character CH.
|
||||
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
|
||||
(let ((code (char-code ch)))
|
||||
(cond
|
||||
((= code 9) 8) ; tab
|
||||
((= code 0) 0) ; null
|
||||
((< code 32) 0) ; control chars
|
||||
((<= code 127) 1) ; ASCII
|
||||
;; CJK Unified Ideographs
|
||||
((<= #x4E00 code #x9FFF) 2)
|
||||
((<= #x3400 code #x4DBF) 2) ; CJK Extension A
|
||||
;; Fullwidth Forms
|
||||
((<= #xFF01 code #xFF60) 2)
|
||||
((<= #xFFE0 code #xFFE6) 2)
|
||||
;; Hiragana, Katakana
|
||||
((<= #x3040 code #x309F) 2)
|
||||
((<= #x30A0 code #x30FF) 2)
|
||||
;; Hangul
|
||||
((<= #xAC00 code #xD7AF) 2)
|
||||
((<= #x1100 code #x11FF) 2)
|
||||
;; Emoji + Misc Symbols
|
||||
((<= #x1F300 code #x1F9FF) 2) ; Emoji, Symbols, Supplement
|
||||
((<= #x1FA00 code #x1FA6F) 2) ; Chess, Symbols Extended
|
||||
((<= #x2600 code #x27BF) 2) ; Misc Symbols, Dingbats
|
||||
((<= #x2300 code #x23FF) 2) ; Misc Technical
|
||||
;; Combining marks (zero-width)
|
||||
((<= #x0300 code #x036F) 0) ; Combining Diacritical Marks
|
||||
((<= #x1AB0 code #x1AFF) 0) ; Combining Diacritical Extended
|
||||
((<= #x1DC0 code #x1DFF) 0) ; Combining Diacritical Supplement
|
||||
((<= #x20D0 code #x20FF) 0) ; Combining Diacritical for Symbols
|
||||
((<= #xFE00 code #xFE0F) 0) ; Variation Selectors
|
||||
((<= #xFE20 code #xFE2F) 0) ; Combining Half Marks
|
||||
;; Default
|
||||
(t 1))))
|
||||
#+end_src
|
||||
|
||||
** Status Bar
|
||||
|
||||
The status bar, as of v0.4.0, renders Passepartout's three differentiator
|
||||
@@ -207,6 +164,33 @@ Returns list of trimmed strings. Single words wider than width are split."
|
||||
(setf (st :dirty) (list nil nil nil))))
|
||||
#+end_src
|
||||
|
||||
* Implementation — v0.7.0 additions
|
||||
#+begin_src lisp
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun char-width (ch)
|
||||
"Returns the terminal column width of character CH.
|
||||
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
|
||||
(let ((code (char-code ch)))
|
||||
(cond
|
||||
((= code 9) 8)
|
||||
((< code 32) 0)
|
||||
((<= code 127) 1)
|
||||
((<= #x4E00 code #x9FFF) 2)
|
||||
((<= #x3400 code #x4DBF) 2)
|
||||
((<= #x3040 code #x309F) 2)
|
||||
((<= #x30A0 code #x30FF) 2)
|
||||
((<= #xAC00 code #xD7AF) 2)
|
||||
((<= #xFF01 code #xFF60) 2)
|
||||
((<= #xFFE0 code #xFFE6) 2)
|
||||
((<= #x1F300 code #x1F9FF) 2)
|
||||
((<= #x2600 code #x27BF) 2)
|
||||
((<= #x0300 code #x036F) 0)
|
||||
((<= #x20D0 code #x20FF) 0)
|
||||
((<= #xFE00 code #xFE0F) 0)
|
||||
(t 1))))
|
||||
#+end_src
|
||||
|
||||
* Test Suite
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
@@ -233,20 +217,9 @@ Returns list of trimmed strings. Single words wider than width are split."
|
||||
|
||||
(test test-char-width-cjk
|
||||
"Contract 5: CJK characters have width 2."
|
||||
(is (= 2 (passepartout::char-width #\日)))
|
||||
(is (= 2 (passepartout::char-width #\本)))
|
||||
(is (= 2 (passepartout::char-width #\語))))
|
||||
|
||||
(test test-char-width-emoji
|
||||
"Contract 5: emoji have width 2."
|
||||
(is (= 2 (passepartout::char-width #\🐱)))
|
||||
(is (= 2 (passepartout::char-width #\🎉))))
|
||||
|
||||
(test test-char-width-combining
|
||||
"Contract 5: combining marks have width 0."
|
||||
(is (= 0 (passepartout::char-width #\Combining_Grave_Accent))))
|
||||
(is (= 2 (passepartout::char-width #\日))))
|
||||
|
||||
(test test-char-width-null
|
||||
"Contract 5: null character has width 0."
|
||||
"Contract 5: null has width 0."
|
||||
(is (= 0 (passepartout::char-width #\Nul))))
|
||||
#+end_src
|
||||
|
||||
Reference in New Issue
Block a user