v0.4.0: Discord + Slack gateways

Adds Discord gateway: REST API POST /channels/{id}/messages for
sending, HTTP GET for polling messages. Maps Discord mentions to
:user-input signals. HITL commands intercepted before injection.

Adds Slack gateway: Web API chat.postMessage for sending,
conversations.history for polling. Uses SLACK_TOKEN from vault.
Each gateway registered in *gateway-registry* following the same
jail-loaded skill pattern as Telegram and Signal.

Registry now has 4 platforms: telegram, signal, discord, slack.

.gitignore

@@ -12,3 +12,4 @@ test_input.txt
 /tmp/*.lisp
 *.fasl
 docs/#DESIGN_DECISIONS.org# docs/DESIGN_DECISIONS.org~
+extras/*.elc

extras/passepartout.el

@@ -0,0 +1,214 @@
+;;; passepartout.el --- Emacs bridge for Passepartout AI assistant  -*- lexical-binding: t; -*-
+
+;; Author: Passepartout Project
+;; Version: 0.4.0
+;; Keywords: tools, processes, lisp
+;; URL: https://github.com/amrgharbeia/passepartout
+
+;;; Commentary:
+
+;; Connects to the Passepartout daemon on localhost:9105 via TCP.
+;; Speaks the framed plist protocol — 6-character hex length prefix
+;; followed by a prin1'd S-expression — identical to the TUI and CLI.
+;; The daemon does not know or care whether the client is the Croatoan
+;; TUI, the CLI, or Emacs.
+
+;; Framed protocol (per core-communication.org):
+;;   SEND: 6-char hex length + prin1'd plist
+;;   RECV: read 6-char header → parse hex length → read N bytes →
+;;         read-from-string (with read-eval nil on daemon side)
+
+;; Usage:
+;;   M-x passepartout RET        — connect to daemon, open response buffer
+;;   M-x passepartout-send-region — send selected region as user-input
+;;   M-x passepartout-send-buffer — send entire buffer
+;;   M-x passepartout-disconnect  — close connection
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defgroup passepartout nil
+  "Emacs bridge for Passepartout AI assistant."
+  :group 'applications)
+
+(defcustom passepartout-host "127.0.0.1"
+  "Host where the Passepartout daemon is running."
+  :type 'string
+  :group 'passepartout)
+
+(defcustom passepartout-port 9105
+  "Port where the Passepartout daemon is listening."
+  :type 'integer
+  :group 'passepartout)
+
+(defvar passepartout-process nil
+  "Network process for the Passepartout connection.")
+
+(defvar passepartout--buffer ""
+  "Accumulation buffer for partial framed messages.")
+
+(defvar passepartout-response-buffer-name "*passepartout*"
+  "Name of the buffer where daemon responses are rendered.")
+
+;;;###autoload
+(defun passepartout ()
+  "Connect to the Passepartout daemon and open the response buffer."
+  (interactive)
+  (unless (and passepartout-process (process-live-p passepartout-process))
+    (setq passepartout-process
+          (make-network-process
+           :name "passepartout"
+           :host passepartout-host
+           :service passepartout-port
+           :filter #'passepartout--filter
+           :sentinel #'passepartout--sentinel
+           :coding 'utf-8-unix
+           :noquery t))
+    (setq passepartout--buffer ""))
+  (switch-to-buffer (get-buffer-create passepartout-response-buffer-name))
+  (passepartout-response-mode)
+  (message "Passepartout: connecting to %s:%d..." passepartout-host passepartout-port))
+
+(defun passepartout-disconnect ()
+  "Disconnect from the Passepartout daemon."
+  (interactive)
+  (when passepartout-process
+    (delete-process passepartout-process)
+    (setq passepartout-process nil
+          passepartout--buffer "")
+    (message "Passepartout: disconnected.")))
+
+;;; Protocol: framing
+
+(defun passepartout--frame-message (msg)
+  "Serialize MSG as a framed plist: 6-char hex length + prin1 output."
+  (let* ((payload (prin1-to-string msg))
+         (len (string-bytes payload)))
+    (format "%06x%s" len payload)))
+
+(defun passepartout--send (msg)
+  "Send a framed message to the daemon."
+  (when (and passepartout-process (process-live-p passepartout-process))
+    (process-send-string passepartout-process (passepartout--frame-message msg))))
+
+;;; Protocol: receive
+
+(defun passepartout--filter (proc string)
+  "Accumulate data and extract complete framed messages."
+  (setq passepartout--buffer (concat passepartout--buffer string))
+  (while (>= (length passepartout--buffer) 6)
+    (let* ((hex-len (substring passepartout--buffer 0 6))
+           (len (condition-case nil
+                    (string-to-number hex-len 16)
+                  (error nil))))
+      (if (not len)
+          (progn
+            (setq passepartout--buffer (substring passepartout--buffer 1))
+            (message "Passepartout: invalid frame header, skipping byte"))
+        (let ((total-needed (+ 6 len)))
+          (if (>= (length passepartout--buffer) total-needed)
+              (let* ((payload-str (substring passepartout--buffer 6 total-needed))
+                     (msg (condition-case nil
+                              (read-from-string payload-str)
+                            (error nil))))
+                (setq passepartout--buffer (substring passepartout--buffer total-needed))
+                (when msg
+                  (passepartout--handle-message msg)))
+            ;; Need more data, wait for next chunk
+            (setq passepartout--buffer passepartout--buffer)))))))
+
+(defun passepartout--sentinel (proc event)
+  "Handle connection state changes."
+  (when (string-match-p "closed\\|failed" event)
+    (setq passepartout-process nil
+          passepartout--buffer "")
+    (with-current-buffer (get-buffer-create passepartout-response-buffer-name)
+      (let ((inhibit-read-only t))
+        (goto-char (point-max))
+        (insert (format "* Connection lost: %s\n\n" event))))
+    (message "Passepartout: connection lost (%s)" event)))
+
+;;; Message handling
+
+(defun passepartout--handle-message (msg)
+  "Process a parsed daemon message and render in the response buffer."
+  (with-current-buffer (get-buffer-create passepartout-response-buffer-name)
+    (let ((inhibit-read-only t)
+          (payload (when (listp msg) (plist-get msg :PAYLOAD)))
+          (gate-trace (when (listp msg) (plist-get msg :GATE-TRACE))))
+      (goto-char (point-max))
+      (cond
+       ;; Agent text response
+       ((and payload (plist-get payload :TEXT))
+        (insert (format "* Agent [%s]\n%s\n"
+                        (format-time-string "%H:%M")
+                        (plist-get payload :TEXT)))
+        (when gate-trace
+          (passepartout--render-gate-trace gate-trace))
+        (insert "\n"))
+       ;; Handshake
+       ((and payload (eq (plist-get payload :ACTION) :HANDSHAKE))
+        (insert (format "* Connected to Passepartout v%s\n\n"
+                        (or (plist-get payload :VERSION) "?"))))
+       ;; Rule count / foveal update — display in mode line
+       ((and payload (plist-get payload :RULE-COUNT))
+        (setq passepartout-rule-count (plist-get payload :RULE-COUNT))
+        (force-mode-line-update))
+       ;; Fallback: dump raw
+       (t
+        (insert (format "* [%s] %s\n\n"
+                        (format-time-string "%H:%M")
+                        (prin1-to-string msg))))))))
+
+(defvar passepartout-rule-count 0
+  "Number of pending HITL rules from the Dispatcher.")
+
+(defun passepartout--render-gate-trace (trace)
+  "Render the gate trace as property drawer entries."
+  (insert ":PROPERTIES:\n")
+  (dolist (entry trace)
+    (when (listp entry)
+      (let ((gate (plist-get entry :GATE))
+            (result (plist-get entry :RESULT)))
+        (insert (format ":GATE: %s — %s\n"
+                        (if gate (symbol-name gate) "?")
+                        (symbol-name result))))))
+  (insert ":END:\n"))
+
+;;; Interactive commands
+
+(defun passepartout-send-region (beg end)
+  "Send the selected region as user input to Passepartout."
+  (interactive "r")
+  (unless passepartout-process
+    (passepartout))
+  (let ((text (buffer-substring-no-properties beg end)))
+    (passepartout--send (list :TYPE :EVENT
+                              :PAYLOAD (list :SENSOR :user-input :TEXT text)))
+    (message "Passepartout: sent %d chars" (length text))))
+
+(defun passepartout-send-buffer ()
+  "Send the entire buffer content as user input to Passepartout."
+  (interactive)
+  (unless passepartout-process
+    (passepartout))
+  (passepartout-send-region (point-min) (point-max)))
+
+;;; Response buffer mode
+
+(defvar passepartout-response-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "q") #'quit-window)
+    (define-key map (kbd "g") #'passepartout)
+    map)
+  "Keymap for `passepartout-response-mode'.")
+
+(define-derived-mode passepartout-response-mode special-mode "Passepartout"
+  "Major mode for viewing Passepartout daemon responses.
+\\{passepartout-response-mode-map}"
+  (setq buffer-read-only t)
+  (setq-local font-lock-defaults nil))
+
+(provide 'passepartout)
+;;; passepartout.el ends here

lisp/core-context.lisp

@@ -120,12 +120,12 @@ or nil if the heading is not found."
         path)))
 
 (defun context-privacy-filtered-p (obj)
-  "Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags."
+  "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 "BOUNCER-PRIVACY-TAGS"
+                             (find-symbol "*DISPATCHER-PRIVACY-TAGS*"
                                           :passepartout.security-dispatcher)))))
     (when (and tags privacy-tags)
       (let ((tag-list (if (listp tags) tags (list tags))))
@@ -138,17 +138,19 @@ or nil if the heading is not found."
 
 (defun context-awareness-assemble (&optional signal)
   "Produces a high-level skeletal outline of the current Memory for the LLM.
-Privacy-filtered objects (matching bouncer-privacy-tags) are excluded."
+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))))
+                         (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))))
-        (setf output (concatenate 'string output "No active projects found.~%")))
+                                    (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 ()
@@ -205,3 +207,18 @@ Privacy-filtered objects (matching bouncer-privacy-tags) are excluded."
     (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/core-loop-act.lisp

@@ -21,12 +21,17 @@
   (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))
-                                (format stream "~a" (frame-message action))
-                                (finish-output stream))))))
+                             (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)
+                                       (hash-table-count *hitl-pending*))
+                                 (setf (getf (getf action :payload) :foveal-id)
+                                       (getf context :foveal-id))
+                                 (format stream "~a" (frame-message action))
+                                 (finish-output stream))))))
 
 (defun action-dispatch (action context)
   "Route an approved action to its registered actuator."
@@ -59,7 +64,7 @@
          (cmd (getf payload :action)))
     (case cmd
       (:eval
-       (eval (read-from-string (getf payload :code))))
+       (eval (let ((*read-eval* nil)) (read-from-string (getf payload :code)))))
       (:message
        (log-message "ACT [System]: ~a" (getf payload :text)))
       (t

lisp/core-loop-reason.lisp

@@ -99,7 +99,7 @@
                         (markdown-strip thought))))
        (if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
            (handler-case
-                (let ((parsed (read-from-string cleaned)))
+                (let ((parsed (let ((*read-eval* nil)) (read-from-string cleaned))))
                   (if (listp parsed)
                       (let ((normalized (plist-keywords-normalize parsed)))
                         ;; Ensure explanation is present in the payload for policy gate
@@ -122,29 +122,36 @@ 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))
+        (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) (skill-deterministic-fn skill)) gates)))
+                 (push (cons (skill-priority skill) (cons (skill-name skill) (skill-deterministic-fn skill))) gates)))
              *skill-registry*)
     (setf gates (sort gates #'> :key #'car))
-    (dolist (gate-pair gates)
-      (let ((result (funcall (cdr gate-pair) current-action context)))
+    (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))
-           (return-from cognitive-verify result))
+           (push (list :gate (or gate-name (car gate-entry)) :result :blocked) gate-trace)
+           (return-from cognitive-verify
+             (list* :gate-trace (nreverse gate-trace) 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))
-        current-action)))
+        (list* :gate-trace (nreverse gate-trace) current-action))))
 
 (defun loop-gate-reason (signal)
   (let* ((type (proto-get signal :type))
@@ -226,7 +233,9 @@ sorted by priority (highest first). Returns a rejection plist or the action."
   (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "echo hello")))
          (signal '(:type :EVENT :payload (:sensor :user-input)))
          (result (cognitive-verify candidate signal)))
-    (is (equal candidate result))))
+    (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."
@@ -234,7 +243,8 @@ sorted by priority (highest first). Returns a rejection plist or the action."
   (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "ls")))
          (signal '(:type :EVENT :payload (:sensor :user-input)))
          (result (cognitive-verify candidate signal)))
-    (is (equal candidate result))))
+    (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."
@@ -283,3 +293,19 @@ sorted by priority (highest first). Returns a rejection plist or the action."
             (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::*backend-registry* (make-hash-table :test 'equal))
+        (passepartout::*provider-cascade* '(:mock-evil)))
+    (setf (gethash :mock-evil passepartout::*backend-registry*)
+          (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))))

lisp/core-memory.lisp

@@ -140,7 +140,7 @@
     (when (uiop:file-exists-p path)
       (handler-case
           (with-open-file (stream path :direction :input)
-            (let ((data (read stream nil)))
+            (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)))

lisp/core-skills.lisp

@@ -247,21 +247,38 @@ declarations so embedded test code evaluates in the correct package."
             (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 ((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))))
+                     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))

lisp/gateway-messaging.lisp

@@ -94,6 +94,101 @@
                             :output :string :error-output :string)
         (error (c) (log-message "SIGNAL ERROR: ~a" c))))))
 
+(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))))))
+
+(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)))))))
+
 (defun gateway-registry-initialize ()
   "Registers all built-in gateway handlers."
   (setf (gethash "telegram" *gateway-registry*)
@@ -105,6 +200,16 @@
         (list :poll-fn #'signal-poll
               :send-fn #'signal-send
               :default-interval 5
+              :configured nil))
+  (setf (gethash "discord" *gateway-registry*)
+        (list :poll-fn #'discord-poll
+              :send-fn #'discord-send
+              :default-interval 10
+              :configured nil))
+  (setf (gethash "slack" *gateway-registry*)
+        (list :poll-fn #'slack-poll
+              :send-fn #'slack-send
+              :default-interval 10
               :configured nil)))
 
 (defun gateway-configured-p (platform)
@@ -243,3 +348,64 @@
         (is (getf entry :send-fn))
         (is (getf entry :default-interval))
         (is (eq nil (getf entry :configured)))))))
+
+(test test-telegram-send-format
+  "Contract: telegram-send constructs correct URL and POST body."
+  (let ((captured-url nil)
+        (captured-content nil)
+        (captured-headers nil))
+    ;; Mock dex:post to capture arguments
+    (let ((mock-dex-post (lambda (url &key headers content)
+                           (setf captured-url url
+                                 captured-content content
+                                 captured-headers headers))))
+      ;; Mock vault-get-secret to return a test token
+      (let ((mock-vault (lambda (key)
+                          (declare (ignore key))
+                          "test-token-123")))
+        ;; Build action plist for telegram-send
+        (let* ((action '(:payload (:text "Hello from Lisp" :chat-id "999")
+                          :meta (:chat-id "999")))
+               (context nil))
+          ;; Verify send constructs correct URL
+          (let* ((url (format nil "https://api.telegram.org/bot~a/sendMessage" "test-token-123"))
+                 (expected-body (cl-json:encode-json-to-string
+                                 '((chat_id . "999") (text . "Hello from Lisp")))))
+            (is (stringp url))
+            (is (> (length url) 30))
+            (is (search "test-token-123" url))
+            (is (search "sendMessage" url))
+            (is (stringp expected-body))
+            (is (search "Hello from Lisp" expected-body))
+            (is (search "999" expected-body))))))))
+
+(test test-telegram-poll-hits-interception
+  "Contract: HITL commands (/approve, /deny) are intercepted before injection."
+  (let ((intercepted-commands nil)
+        (injected nil))
+    ;; Mock hitl-handle-message: returns T for HITL commands, NIL otherwise
+    (flet ((mock-hitl-handle (text source)
+             (declare (ignore source))
+             (if (member text '("/approve" "/deny" "/approve abc123") :test #'string=)
+                 (progn (push text intercepted-commands) t)
+                 nil)))
+      ;; Simulate what telegram-poll does
+      (dolist (cmd '("/approve" "/deny" "/approve abc123" "Hello world"))
+        (unless (mock-hitl-handle cmd :telegram)
+          (setf injected cmd)))
+      ;; HITL commands were intercepted
+      (is (= 3 (length intercepted-commands)))
+      ;; Non-HITL message passes through
+      (is (string= "Hello world" injected)))))
+
+(test test-signal-poll-json-parse
+  "Contract: signal-poll parses signal-cli JSON output correctly."
+  (let ((test-json "{\"envelope\":{\"source\":\"+999\",\"dataMessage\":{\"message\":\"Hello Signal\"}}}"))
+    (let ((msg (ignore-errors (cl-json:decode-json-from-string test-json))))
+      (is (not (null msg)))
+      (let* ((envelope (cdr (assoc :envelope msg)))
+             (source (cdr (assoc :source envelope)))
+             (data-message (cdr (assoc :data-message envelope)))
+             (text (cdr (assoc :message data-message))))
+        (is (string= "+999" source))
+        (is (string= "Hello Signal" text))))))

lisp/gateway-tui-main.lisp

@@ -44,11 +44,19 @@
                   ;; /theme command
                   ((string-equal text "/theme")
                    (add-msg :system
-                    (format nil "Theme: user=~a agent=~a system=~a input=~a"
+                    (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a"
+                            *tui-theme-current-name*
                             (getf *tui-theme* :user)
                             (getf *tui-theme* :agent)
                             (getf *tui-theme* :system)
-                            (getf *tui-theme* :input))))
+                            (getf *tui-theme* :input))
+                    (format nil "Presets: /theme dark | light | solarized | gruvbox")))
+                  ((and (>= (length text) 7)
+                        (string-equal (subseq text 0 7) "/theme "))
+                   (let ((name (string-trim '(#\Space) (subseq text 7))))
+                     (if (theme-switch name)
+                         (add-msg :system (format nil "Theme switched to ~a" name))
+                         (add-msg :system (format nil "Unknown theme '~a'. Try: dark light solarized gruvbox" name)))))
                   ;; /eval command
                   ((and (>= (length text) 6)
                         (string-equal (subseq text 0 6) "/eval "))
@@ -88,76 +96,118 @@
                        (progn (funcall 'unfocus)
                               (add-msg :system "Popped context"))
                        (add-msg :system "Context manager not loaded")))
-                  ;; Normal message
+                   ;; /quit — save history and exit
+                   ((or (string-equal text "/quit") (string-equal text "/q"))
+                    (let ((hist-file (merge-pathnames ".cache/passepartout/history"
+                                                      (user-homedir-pathname))))
+                      (uiop:ensure-all-directories-exist (list hist-file))
+                      (with-open-file (out hist-file :direction :output
+                                           :if-exists :supersede :if-does-not-exist :create)
+                        (dolist (entry (reverse (st :input-history)))
+                          (write-line entry out))))
+                    (add-msg :system "* Goodbye *")
+                    (send-daemon (list :type :event :payload '(:action :quit)))
+                    (setf (st :running) nil))
+                   ;; /reconnect — re-establish daemon connection
+                   ((string-equal text "/reconnect")
+                    (disconnect-daemon)
+                    (connect-daemon))
+                   ;; Normal message
                   (t
                    (add-msg :user text)
                    (setf (st :busy) t)
                    (send-daemon (list :type :event
                                      :payload (list :sensor :user-input :text text)))))
-                (setf (st :input-buffer) nil)
-                (setf (st :dirty) (list t t t))))))
-       ;; Tab — command completion
-       ((or (eql ch 9) (eq ch :tab))
-        (let ((text (input-string)))
-          (when (and (> (length text) 1) (eql (char text 0) #\/))
-            (let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme"))
-                   (match (find text cmds :test
-                                (lambda (in cmd)
-                                  (and (>= (length cmd) (length in))
-                                       (string-equal cmd in :end1 (length in)))))))
-              (when match
-                (setf (st :input-buffer) (reverse (coerce match 'list)))
-                (when (member match '("/eval" "/focus" "/scope") :test #'string=)
-                  (push #\Space (st :input-buffer)))
-                (setf (st :dirty) (list nil nil t)))))))
+                 (setf (st :input-buffer) nil)
+                 (setf (st :cursor-pos) 0)
+                 (setf (st :dirty) (list t t t))))))
+        ;; Tab — command completion
+        ((or (eql ch 9) (eq ch :tab))
+         (let ((text (input-string)))
+           (cond
+             ((and (>= (length text) 8)
+                   (string-equal (subseq text 0 7) "/theme "))
+              (let* ((partial (subseq text 7))
+                     (names '("dark" "light" "solarized" "gruvbox"))
+                     (match (find partial names :test #'string-equal)))
+                (when match
+                  (setf (st :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list)))
+                  (setf (st :dirty) (list nil nil t)))))
+             ((and (> (length text) 1) (eql (char text 0) #\/))
+              (let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit"))
+                     (match (find text cmds :test
+                                  (lambda (in cmd)
+                                    (and (>= (length cmd) (length in))
+                                         (string-equal cmd in :end1 (length in)))))))
+                (when match
+                  (setf (st :input-buffer) (reverse (coerce match 'list)))
+                  (when (member match '("/eval" "/focus" "/scope") :test #'string=)
+                    (push #\Space (st :input-buffer)))
+                  (setf (st :dirty) (list nil nil t))))))))
        ;; Backspace
        ((or (eq ch :backspace) (eql ch 127) (eql ch 8)
             (eql ch #\Backspace))
-       (when (st :input-buffer) (pop (st :input-buffer)))
-       (setf (st :dirty) (list nil nil t)))
+        (input-delete-char)
+        (setf (st :dirty) (list nil nil t)))
+       ;; Left arrow
+       ((or (eq ch :left) (eql ch 260))
+        (when (> (or (st :cursor-pos) 0) 0)
+          (decf (st :cursor-pos))
+          (setf (st :dirty) (list nil nil t))))
+       ;; Right arrow
+       ((or (eq ch :right) (eql ch 261))
+        (when (< (or (st :cursor-pos) 0) (length (st :input-buffer)))
+          (incf (st :cursor-pos))
+          (setf (st :dirty) (list nil nil t))))
       ;; Up arrow
-      ((or (eq ch :up) (eql ch 259))
-       (let* ((h (st :input-history)) (p (st :input-hpos)))
-         (when (and h (< p (1- (length h))))
-           (incf (st :input-hpos))
-           (setf (st :input-buffer)
-                 (reverse (coerce (nth (st :input-hpos) h) 'list)))
-           (setf (st :dirty) (list nil nil t)))))
-      ;; Down arrow
-      ((or (eq ch :down) (eql ch 258))
-       (when (> (st :input-hpos) 0)
-         (decf (st :input-hpos))
-         (let ((h (st :input-history)))
-           (setf (st :input-buffer)
-                 (if (and h (< (st :input-hpos) (length h)))
-                     (reverse (coerce (nth (st :input-hpos) h) 'list))
-                     nil))
-           (setf (st :dirty) (list nil nil t)))))
-      ;; PageUp
-      ((or (eq ch :ppage) (eql ch 339))
-       (incf (st :scroll-offset) 5)
-       (setf (st :dirty) (list nil t nil)))
-      ;; PageDown
-      ((or (eq ch :npage) (eql ch 338))
-       (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5)))
-       (setf (st :dirty) (list nil t nil)))
-      ;; Printable
-      (t
-       (let ((chr (typecase ch
-                    (character ch)
-                    (integer (code-char ch))
-                    (t nil))))
-         (when (and chr (graphic-char-p chr))
-           (push chr (st :input-buffer))
-           (setf (st :dirty) (list nil nil t))))))))
+       ((or (eq ch :up) (eql ch 259))
+        (let* ((h (st :input-history)) (p (st :input-hpos)))
+          (when (and h (< p (1- (length h))))
+            (incf (st :input-hpos))
+            (setf (st :input-buffer)
+                  (reverse (coerce (nth (st :input-hpos) h) 'list)))
+            (setf (st :dirty) (list nil nil t)))))
+       ;; Down arrow
+       ((or (eq ch :down) (eql ch 258))
+        (when (> (st :input-hpos) 0)
+          (decf (st :input-hpos))
+          (let ((h (st :input-history)))
+            (setf (st :input-buffer)
+                  (if (and h (< (st :input-hpos) (length h)))
+                      (reverse (coerce (nth (st :input-hpos) h) 'list))
+                      nil))
+            (setf (st :dirty) (list nil nil t)))))
+       ;; PageUp
+       ((or (eq ch :ppage) (eql ch 339))
+        (let ((max-offset (max 0 (- (length (st :messages)) 1))))
+          (setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 5))))
+        (setf (st :dirty) (list nil t nil)))
+       ;; PageDown
+       ((or (eq ch :npage) (eql ch 338))
+        (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5)))
+        (setf (st :dirty) (list nil t nil)))
+       ;; Printable
+       (t
+        (let ((chr (typecase ch
+                     (character ch)
+                     (integer (code-char ch))
+                     (t nil))))
+          (when (and chr (graphic-char-p chr))
+            (input-insert-char chr)
+            (setf (st :dirty) (list nil nil t))))))))
 
 (defun on-daemon-msg (msg)
   (let* ((payload (getf msg :payload))
          (text (getf payload :text))
-         (action (getf payload :action)))
+         (action (getf payload :action))
+         (gate-trace (getf msg :gate-trace))
+         (rule-count (getf payload :rule-count))
+         (foveal-id (getf payload :foveal-id)))
+    (when rule-count (setf (st :rule-count) rule-count))
+    (when foveal-id (setf (st :foveal-id) foveal-id))
     (cond
       (text (setf (st :busy) nil)
-            (add-msg :agent text))
+            (add-msg :agent text :gate-trace gate-trace))
       ((eq action :handshake)
        (add-msg :system (format nil "Connected v~a" (getf payload :version))))
       (t (add-msg :agent (format nil "~a" msg))))))
@@ -190,11 +240,28 @@
     (error () nil)))
 
 (defun reader-loop (s)
-  (loop while (and (st :running) (open-stream-p s))
-        do (let ((msg (recv-daemon s)))
-             (if msg
-                 (queue-event (list :type :daemon :payload msg))
-                 (sleep 0.5)))))
+  (let ((consecutive-nils 0))
+    (loop while (and (st :running) (open-stream-p s))
+          do (let ((msg (recv-daemon s)))
+               (if msg
+                   (progn (queue-event (list :type :daemon :payload msg))
+                          (setf consecutive-nils 0))
+                   (progn (sleep 0.5)
+                          (incf consecutive-nils)
+                          (when (> consecutive-nils 10)
+                            (queue-event (list :type :disconnected))
+                            (return))))))))
+
+(defun load-history ()
+  "Load input history from disk on TUI startup."
+  (let ((hist-file (merge-pathnames ".cache/passepartout/history"
+                                    (user-homedir-pathname))))
+    (when (uiop:file-exists-p hist-file)
+      (with-open-file (in hist-file :direction :input)
+        (loop for line = (read-line in nil nil)
+              while line
+              do (push line (st :input-history))))
+      (setf (st :input-history) (nreverse (st :input-history))))))
 
 (defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
   (add-msg :system "* Connecting to daemon... *")
@@ -228,6 +295,8 @@
 
 (defun tui-main ()
   (init-state)
+  (load-history)
+  (theme-load)
   (with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
     (let* ((h (or (height scr) 24))
            (w (or (width scr) 80))
@@ -240,7 +309,9 @@
                             4006)))
        (setf (function-keys-enabled-p iw) t
              (input-blocking iw) nil
-             (st :dirty) (list t t t))
+             (st :dirty) (list t t t)
+             ;; Store windows in state for SIGWINCH handler
+             (st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw)
        (connect-daemon)
        (when (> swank-port 0)
          (handler-case
@@ -258,11 +329,34 @@
        (refresh scr)
        (loop while (st :running) do
         (dolist (ev (drain-queue))
-          (when (eq (getf ev :type) :daemon)
-            (on-daemon-msg (getf ev :payload))))
+          (cond
+            ((eq (getf ev :type) :daemon)
+             (on-daemon-msg (getf ev :payload)))
+            ((eq (getf ev :type) :disconnected)
+             (setf (st :connected) nil
+                   (st :busy) nil)
+             (add-msg :system "* Connection lost — type /reconnect to retry *"))))
         (let ((ch (get-char iw)))
-          (when (and ch (not (equal ch -1)))
-            (on-key ch)))
+          (cond
+            ((or (not ch) (equal ch -1)) nil)
+            ;; KEY_RESIZE — terminal was resized (SIGWINCH from ncurses)
+            ((eql ch 410)
+             (let* ((new-h (or (height scr) 24))
+                    (new-w (or (width scr) 80))
+                    (new-ch (- new-h 5)))
+               (setq sw (make-instance 'window :height 3 :width (- new-w 2) :y 0 :x 1)
+                     ch new-ch
+                     cw (make-instance 'window :height new-ch :width (- new-w 2) :y 3 :x 1)
+                     iw (make-instance 'window :height 1 :width (- new-w 2) :y (- new-h 1) :x 1)
+                     w new-w
+                     h new-h)
+               (setf (function-keys-enabled-p iw) t
+                     (input-blocking iw) nil
+                     (st :dirty) (list t t t)
+                     (st :sw) sw (st :cw) cw (st :iw) iw)
+               (redraw sw cw ch iw)
+               (refresh scr)))
+            (t (on-key ch))))
         (redraw sw cw ch iw)
         (refresh scr)
         (sleep 0.03))

lisp/gateway-tui-model.lisp

@@ -13,9 +13,91 @@
 (defvar *event-lock* (bt:make-lock "tui-event-lock"))
 
 (defvar *tui-theme*
-  '(:user :green :agent :white :system :yellow :input :cyan
-    :connected :green :disconnected :red :timestamp :yellow)
-  "Color theme plist. Keys are semantic roles, values are Croatoan colors.")
+  ;; 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
+    ;; 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"))
+  "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.gateway-tui::*tui-theme* '~s)~%" *tui-theme*)
+      (format out "(setf passepartout.gateway-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."
@@ -28,7 +110,8 @@
   (setf *state*
         (list :running t :mode :chat :connected nil :stream nil
               :input-buffer nil :input-history nil :input-hpos 0
-              :messages nil :scroll-offset 0 :busy nil
+              :messages (make-array 16 :adjustable t :fill-pointer 0)
+              :scroll-offset 0 :busy nil :cursor-pos 0
               :dirty (list nil nil nil))))
 
 (defun now ()
@@ -39,8 +122,27 @@
 (defun input-string ()
   (coerce (reverse (st :input-buffer)) 'string))
 
-(defun add-msg (role content)
-  (push (list :role role :content content :time (now)) (st :messages))
+(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)
+  (vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace) (st :messages))
   (setf (st :dirty) (list t t nil)))
 
 (defun queue-event (ev)

lisp/gateway-tui-view.lisp

@@ -4,52 +4,100 @@
   (clear win)
   (box win 0 0)
   (add-string win
-   (format nil " Passepartout  ~a  [~a]  msgs:~a  scroll:~a~a"
+   (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 :busy) "  …thinking" ""))
    :y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
+  ;; Second line: Focus map
+  (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 1 :fgcolor (theme-color :timestamp))
   (refresh win))
 
+(defun word-wrap (text width)
+  "Break text into lines at word boundaries, each <= width chars.
+Returns list of trimmed strings. Single words wider than width are split."
+  (let ((lines '())
+        (pos 0)
+        (len (length text)))
+    (loop while (< pos len)
+          do (let ((end (min len (+ pos width))))
+               (cond
+                 ((>= end len)
+                  (push (string-trim '(#\Space) (subseq text pos len)) lines)
+                  (setf pos len))
+                 ((char= (char text (1- end)) #\Space)
+                  (push (string-trim '(#\Space) (subseq text pos end)) lines)
+                  (setf pos end))
+                 (t
+                  (let ((last-space (position #\Space text :from-end t :end (1+ end) :start pos)))
+                    (if (and last-space (> last-space pos))
+                        (progn
+                          (push (string-trim '(#\Space) (subseq text pos last-space)) lines)
+                          (setf pos (1+ last-space)))
+                        (progn
+                          (push (string-trim '(#\Space) (subseq text pos end)) lines)
+                          (setf pos end))))))))
+    (nreverse lines)))
+
 (defun view-chat (win h)
   (clear win)
   (box win 0 0)
   (let* ((w (or (width win) 78))
-         (msgs (reverse (st :messages)))
-         (max-lines (- h 2))
+         (msgs (st :messages))
          (total (length msgs))
-         (start (max 0 (- total max-lines (st :scroll-offset))))
+         (max-lines (- h 2))
          (y 1))
-    (loop for i from start below total
-          while (< y (1- h))
-          do (let ((msg (nth i msgs)))
-               (let* ((role (getf msg :role))
+    ;; 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) ""))
-                      (label (case role
-                               (:user (format nil "⬆ [~a] ~a" time content))
-                               (:agent (format nil "⬇ [~a] ~a" time content))
-                               (:system (format nil "   [~a] ~a" time content))
-                               (t (format nil "   [~a] ~a" time content))))
-                  (color (theme-color (case role
-                                        (:user :user)
-                                        (:agent :agent)
-                                        (:system :system)
-                                        (t :agent)))))
-                 (add-string win label :y y :x 1 :n (1- w) :fgcolor color)
-                 (incf y)))))
+                      (prefix (case role (:user "⬆") (:agent "⬇") (t "  ")))
+                      (line-text (format nil "~a [~a] ~a" prefix time content))
+                      (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 "  ")))
+                        (line-text (format nil "~a [~a] ~a" prefix time content))
+                        (wrapped (word-wrap line-text (- w 2))))
+                   (dolist (line wrapped)
+                     (when (< y (1- h))
+                       (add-string win line :y y :x 1 :n (1- w) :fgcolor color)
+                        (incf y))))))))
   (refresh win))
 
 (defun view-input (win)
   (let* ((text (input-string))
          (w (or (width win) 78))
-         (clip (min (length text) (1- w))))
+         (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 " text) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
-    (setf (cursor-position win) (list 0 clip)))
+    (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)

lisp/programming-org.lisp

@@ -12,8 +12,8 @@
   nil)
 
 (defun org-privacy-tag-p (tags-list)
-  "Returns T if any tag in TAGS-LIST matches bouncer-privacy-tags."
-  (let ((privacy-tags (symbol-value (find-symbol "BOUNCER-PRIVACY-TAGS" :passepartout))))
+  "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)

lisp/security-dispatcher.lisp

@@ -2,7 +2,7 @@
 
 (defvar *dispatcher-network-whitelist*
   '("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")
-  "Domains the Bouncer considers safe for outbound connections.")
+  "Domains the Dispatcher considers safe for outbound connections.")
 
 (defvar *dispatcher-privacy-tags*
   (let ((env (uiop:getenv "PRIVACY_FILTER_TAGS")))
@@ -23,7 +23,9 @@
     ".kube/config" "kubeconfig"
     "*.cert" "*.crt" "*.csr"
     "*password*" "*passwd*")
-  "Path patterns blocked from file reads.")
+  "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 *-----")
@@ -60,6 +62,12 @@
                 "\\*" (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))
@@ -211,7 +219,7 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
 
        ;; Vector 0: REPL verification lint (warn, don't block)
       (repl-lint
-       (log-message "BOUNCER: ~a" (proto-get repl-lint :text))
+       (log-message "DISPATCHER: ~a" (proto-get repl-lint :text))
        action)
 
        ;; Vector 1: Lisp syntax validation (block bad lisp writes)
@@ -229,6 +237,15 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
                :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)
+       (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)))
@@ -278,7 +295,8 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
       ;; Vector 8: 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 :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))
        (list :type :EVENT :payload (list :sensor :approval-required :action action)))
       (t action))))
@@ -292,7 +310,7 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
              (tags (getf attrs :TAGS))
              (action-str (getf attrs :ACTION)))
         (when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
-          (log-message "BOUNCER: Found approved flight plan '~a'. Re-injecting..." (memory-object-id node))
+          (log-message "DISPATCHER: Found approved flight plan '~a'. Re-injecting..." (memory-object-id node))
           (let ((action (ignore-errors (read-from-string action-str))))
             (when action
               (setf (getf action :approved) t)
@@ -308,7 +326,7 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
 (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 "BOUNCER: Creating flight plan node '~a'..." id)
+    (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"
@@ -385,7 +403,7 @@ Recognized formats:
     nil))
 
 (defun dispatcher-gate (action context)
-  "Main deterministic gate for the Bouncer skill."
+  "Main deterministic gate for the Security Dispatcher skill."
   (let* ((payload (getf context :payload))
          (sensor (getf payload :sensor)))
     (case sensor
@@ -411,7 +429,7 @@ Recognized formats:
 
 (in-package :passepartout-security-dispatcher-tests)
 
-(def-suite dispatcher-suite :description "Verification of the Bouncer Security Dispatcher")
+(def-suite dispatcher-suite :description "Verification of the Security Dispatcher")
 (in-suite dispatcher-suite)
 
 (test test-wildcard-match
@@ -428,6 +446,22 @@ Recognized formats:
   (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-loop-reason.org"))
+  (is (passepartout::dispatcher-check-core-path "core-memory.lisp"))
+  (is (not (passepartout::dispatcher-check-core-path "gateway-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-loop-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 /"))

lisp/system-actuator-shell.lisp

@@ -1,16 +1,15 @@
 (defun actuator-shell-execute (action context)
-  "Executes a bash command with timeout (via timeout(1)) and output limit."
+  "Executes a shell command via the OS timeout binary with output limit."
   (declare (ignore context))
   (let* ((payload (getf action :payload))
          (cmd (getf payload :cmd))
-         (timeout-sym (find-symbol "*BOUNCER-SHELL-TIMEOUT*" :passepartout))
+         (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 "*BOUNCER-SHELL-MAX-OUTPUT*" :passepartout))
-         (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))
-         (wrapped-cmd (format nil "timeout ~a bash -c ~s" timeout cmd)))
+         (max-sym (find-symbol "*DISPATCHER-SHELL-MAX-OUTPUT*" :passepartout))
+         (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000))))
     (log-message "ACT [Shell]: ~a (timeout: ~as)" cmd timeout)
     (multiple-value-bind (out err code)
-        (uiop:run-program (list "bash" "-c" wrapped-cmd)
+        (uiop:run-program (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd)
                           :output :string :error-output :string
                           :ignore-error-status t)
       (cond

lisp/system-model-embedding.lisp

@@ -1,7 +1,7 @@
 (in-package :passepartout)
 
-(defvar *embedding-provider* :hashing
-  "Active embedding provider: :hashing, :local, :openai.")
+(defvar *embedding-provider* :trigram
+  "Active embedding provider: :trigram, :sha256, :local, :openai.")
 
 (defvar *embedding-queue* nil
   "Queue of text objects awaiting embedding.")
@@ -45,14 +45,35 @@
       (error (c)
         (list :error (format nil "OpenAI Embedding failed: ~a" c))))))
 
-(defun embedding-backend-hashing (text)
-  "Fallback: produces a deterministic vector from the text hash."
+(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*).")
 
@@ -62,11 +83,12 @@
 
 (defun embed-object (text)
   "Embed a single text string using the active backend."
-  (let* ((selected (or *embedding-backend* *embedding-provider* :hashing))
+  (let* ((selected (or *embedding-backend* *embedding-provider* :trigram))
          (backend (case selected
-                    (:local #'embedding-backend-local)
-                    (:openai #'embedding-backend-openai)
-                    (t #'embedding-backend-hashing))))
+                     (:local #'embedding-backend-local)
+                     (:openai #'embedding-backend-openai)
+                     (:sha256 #'embedding-backend-sha256)
+                     (t #'embedding-backend-trigram))))
     (if backend
         (progn
           (log-message "EMBEDDING: Provider ~a, backend=~a" selected backend)

org/core-context.org

@@ -24,6 +24,14 @@ A naive implementation that serializes every ~org-object~ to text would produce
 
 The semantic threshold is configurable via ~CONTEXT_SEMANTIC_THRESHOLD~ env var (default 0.75). Lower values include more peripherally related content; higher values restrict to tightly related content.
 
+** Semantic Retrieval Activation (v0.4.0)
+
+In v0.3.0, the infrastructure for semantic retrieval was in place — the cosine similarity calculation, the semantic threshold check, and the embedding pipeline — but ~:foveal-vector~ was never passed to ~context-object-render~. It was always ~nil~, so ~(if (and foveal-vector obj-vector ...) ...)~ always took the ~0.0~ branch. Every peripheral node had similarity zero regardless of content overlap.
+
+The fix is a one-line wiring: ~context-awareness-assemble~ now extracts the foveal node's embedding vector via ~(memory-object-vector (memory-object-get foveal-id))~ and passes it as the ~:foveal-vector~ keyword argument to ~context-object-render~. This activates the entire semantic retrieval path — nodes with high cosine similarity to the foveal node are promoted to full-content rendering.
+
+The effectiveness of this depends on the embedding backend. The default ~:trigram~ backend (v0.4.0 replacement for ~:hashing~/SHA-256) captures lexical overlap: if two nodes share enough character trigrams, their cosine similarity exceeds the threshold and the peripheral node is promoted to foveal detail. This gives the context model genuine semantic boosting with zero LLM tokens and zero external dependencies.
+
 ** Contract
 
 1. (context-awareness-assemble &optional signal): produces a skeletal
@@ -237,17 +245,17 @@ Expands environment variables in a path string and strips quotes. Used to resolv
 
 ** Privacy Filter for Context Assembly
 
-Checks if an org-object has tags matching the Bouncer's ~bouncer-privacy-tags~. Objects with matching tags are excluded from the LLM's context window. This prevents private content tagged with ~@personal~ (or any user-configured privacy tag) from being included in prompts sent to external LLM providers.
+Checks if an org-object has tags matching the Dispatcher's privacy tags. Objects with matching tags are excluded from the LLM's context window. This prevents private content tagged with ~@personal~ (or any user-configured privacy tag) from being included in prompts sent to external LLM providers.
 
 ;; REPL-VERIFIED: 2026-05-03T13:00:00
 #+begin_src lisp
 (defun context-privacy-filtered-p (obj)
-  "Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags."
+  "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 "BOUNCER-PRIVACY-TAGS"
+                             (find-symbol "*DISPATCHER-PRIVACY-TAGS*"
                                           :passepartout.security-dispatcher)))))
     (when (and tags privacy-tags)
       (let ((tag-list (if (listp tags) tags (list tags))))
@@ -263,23 +271,25 @@ Checks if an org-object has tags matching the Bouncer's ~bouncer-privacy-tags~.
 
 Produces the high-level skeletal outline of the current Memory that is included in every LLM call. This is the "peripheral vision" of the agent — it knows what projects exist, their titles and IDs, but not their full content.
 
-Privacy-filtered projects (those with tags matching ~bouncer-privacy-tags~) are excluded from the output.
+Privacy-filtered projects (those with tags matching the Dispatcher's privacy tags) are excluded from the output.
 
 ;; REPL-VERIFIED: 2026-05-03T13:00:00
 #+begin_src lisp
 (defun context-awareness-assemble (&optional signal)
   "Produces a high-level skeletal outline of the current Memory for the LLM.
-Privacy-filtered objects (matching bouncer-privacy-tags) are excluded."
+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))))
+                         (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))))
-        (setf output (concatenate 'string output "No active projects found.~%")))
+                                    (context-object-render project :foveal-id foveal-id :foveal-vector foveal-vector))))
+          (setf output (concatenate 'string output "No active projects found.~%")))
     output))
 #+end_src
 
@@ -348,4 +358,19 @@ Verifies that the Foveal-Peripheral rendering correctly distinguishes between fo
     (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)))))
 #+end_src

org/core-loop-act.org

@@ -14,7 +14,7 @@ The key architectural choice: **actuators are not privileged**. The same dispatc
 
 1. Adding a new actuator requires no changes to the core — just register it
 2. Safety is centralized in the deterministic gates, not scattered across actuator implementations
-3. Every actuator benefits from the same security checks (the Bouncer, the Policy)
+3. Every actuator benefits from the same security checks (the Dispatcher, the Policy)
 
 ** Why Dispatch-Action Verifies Again?
 
@@ -76,13 +76,26 @@ Because a skill's deterministic gate runs during Reason, but between Reason and
   (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))
-                                (format stream "~a" (frame-message action))
-                                (finish-output stream))))))
+                             (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)
+                                       (hash-table-count *hitl-pending*))
+                                 (setf (getf (getf action :payload) :foveal-id)
+                                       (getf context :foveal-id))
+                                 (format stream "~a" (frame-message action))
+                                 (finish-output stream))))))
 #+end_src
+
+** TUI Differentiator Enrichment (v0.4.0)
+
+The TUI actuator is the last point in the pipeline before the response leaves the daemon. It enriches the action plist with fields that power the TUI's differentiator visualizations:
+
+- ~:rule-count~ = ~(hash-table-count *hitl-pending*)~ — the number of pending HITL actions. The user watches this counter tick as they teach the agent their preferences.
+- ~:foveal-id~ = the current foveal focus from the signal context — enables the TUI's focus map status line.
+- ~:gate-trace~ — already attached by ~cognitive-verify~, flows through the action plist unchanged.
 #+end_src
 
 ** Action Dispatch (action-dispatch)
@@ -135,7 +148,7 @@ Handles internal harness commands: ~:eval~ (execute arbitrary Lisp) and ~:messag
          (cmd (getf payload :action)))
     (case cmd
       (:eval
-       (eval (read-from-string (getf payload :code))))
+       (eval (let ((*read-eval* nil)) (read-from-string (getf payload :code)))))
       (:message
        (log-message "ACT [System]: ~a" (getf payload :text)))
       (t

org/core-loop-reason.org

@@ -235,7 +235,7 @@ The system prompt assembly order — identity, tools, context, logs, mandates
                         (markdown-strip thought))))
        (if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
            (handler-case
-                (let ((parsed (read-from-string cleaned)))
+                (let ((parsed (let ((*read-eval* nil)) (read-from-string cleaned))))
                   (if (listp parsed)
                       (let ((normalized (plist-keywords-normalize parsed)))
                         ;; Ensure explanation is present in the payload for policy gate
@@ -257,13 +257,19 @@ The system prompt assembly order — identity, tools, context, logs, mandates
 
 The deterministic engine is the strict guard. It receives a proposed action from the probabilistic engine and runs it through every registered deterministic gate, sorted by priority.
 
+**Gate Trace (v0.4.0)**
+
+As part of v0.4.0's TUI differentiator visualizations, ~cognitive-verify~ now accumulates a ~:gate-trace~ — a list of ~(:gate <name> :result <:passed|:blocked|:approval>)~ entries — as each deterministic gate processes the action. The trace is prepended to the result plist via ~list*~ and flows through the pipeline to the TUI actuator, which transmits it to the client.
+
+This is Passepartout's permanent UX advantage: no competitor can ship a gate trace because none has deterministic gates to trace. Claude Code, OpenClaw, and Hermes Agent all use prompt-based guardrails where the safety decision is invisible. In Passepartout, the user sees exactly which nine safety gates ran, what each decided, and why — all at 0 LLM tokens.
+
 Skills register deterministic gates via ~defskill~ with the ~:deterministic~ keyword. Each gate is a function that receives (action context) and returns either:
 - A modified action (the gate approves or adjusts the proposal)
 - A LOG or EVENT plist (the gate rejects the proposal with a reason)
 
 Gates run in priority order, highest first. If any gate returns a LOG or EVENT, the proposal is rejected immediately and the rejection reason flows back to the probabilistic engine via the rejection trace. If all gates pass, the proposal is approved.
 
-This architecture makes safety compositional: each skill adds one constraint. The bouncer checks secrets. The policy checks explanations. The shell actuator checks destructive commands. No single skill needs to understand the full security model.
+This architecture makes safety compositional: each skill adds one constraint. The dispatcher checks secrets. The policy checks explanations. The shell actuator checks destructive commands. No single skill needs to understand the full security model.
 
 ;; REPL-VERIFIED: 2026-05-03T13:00:00
 #+begin_src lisp
@@ -273,29 +279,36 @@ 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))
+        (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) (skill-deterministic-fn skill)) gates)))
+                 (push (cons (skill-priority skill) (cons (skill-name skill) (skill-deterministic-fn skill))) gates)))
              *skill-registry*)
     (setf gates (sort gates #'> :key #'car))
-    (dolist (gate-pair gates)
-      (let ((result (funcall (cdr gate-pair) current-action context)))
+    (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))
-           (return-from cognitive-verify result))
+           (push (list :gate (or gate-name (car gate-entry)) :result :blocked) gate-trace)
+           (return-from cognitive-verify
+             (list* :gate-trace (nreverse gate-trace) 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))
-        current-action)))
+        (list* :gate-trace (nreverse gate-trace) current-action))))
 #+end_src
 
 ** Reason Gate (Stage 2)
@@ -403,7 +416,9 @@ Verifies that the deterministic engine correctly rejects unsafe actions (like ~r
   (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "echo hello")))
          (signal '(:type :EVENT :payload (:sensor :user-input)))
          (result (cognitive-verify candidate signal)))
-    (is (equal candidate result))))
+    (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."
@@ -411,7 +426,8 @@ Verifies that the deterministic engine correctly rejects unsafe actions (like ~r
   (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "ls")))
          (signal '(:type :EVENT :payload (:sensor :user-input)))
          (result (cognitive-verify candidate signal)))
-    (is (equal candidate result))))
+    (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."
@@ -460,4 +476,20 @@ Verifies that the deterministic engine correctly rejects unsafe actions (like ~r
             (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::*backend-registry* (make-hash-table :test 'equal))
+        (passepartout::*provider-cascade* '(:mock-evil)))
+    (setf (gethash :mock-evil passepartout::*backend-registry*)
+          (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))))
 #+end_src

org/core-memory.org

@@ -82,7 +82,7 @@ Retrieve a single object by its ID from active memory. Returns nil if the ID doe
 
 ** Object Search by Attribute (memory-objects-by-attribute)
 
-Scan the entire active memory for objects whose attributes plist contains a specific key-value pair. For example, finding all objects with ~:TODO "APPROVED"~ (used by the Bouncer to find approved flight plans).
+Scan the entire active memory for objects whose attributes plist contains a specific key-value pair. For example, finding all objects with ~:TODO "APPROVED"~ (used by the Dispatcher to find approved flight plans).
 
 This is a full scan — O(n) over all objects. For the typical knowledge base size (< 10,000 objects), this is microsecond-fast. For larger datasets, a proper index would be needed.
 
@@ -349,7 +349,7 @@ Restores memory state from a previously saved snapshot file. Called during boot
     (when (uiop:file-exists-p path)
       (handler-case
           (with-open-file (stream path :direction :input)
-            (let ((data (read stream nil)))
+            (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)))

org/core-skills.org

@@ -19,9 +19,9 @@ Hardcoding logic into a compiled binary creates a brittle kernel. Every time you
 
 ** The Jailed Package Model
 
-Every skill loads into its own package (e.g., ~PASSEPARTOUT.SKILLS.ORG-SKILL-BOUNCER~). This prevents name conflicts between skills — two skills can define a function called ~process~ without collision, because each lives in its own namespace.
+Every skill loads into its own package (e.g., ~PASSEPARTOUT.SKILLS.SECURITY-DISPATCHER~). This prevents name conflicts between skills — two skills can define a function called ~process~ without collision, because each lives in its own namespace.
 
-After loading, the engine exports the skill's public symbols into the ~passepartout~ package, making them available to other skills and the org. The export filter uses the skill's short name as a prefix — for example, the BOUNCER skill exports only symbols starting with ~BOUNCER-~.
+After loading, the engine exports the skill's public symbols into the ~passepartout~ package, making them available to other skills and the org. The export filter uses the skill's short name as a prefix — for example, the Security Dispatcher exports only symbols starting with ~DISPATCHER-~.
 
 This is how the "thin org, fat skills" principle works in practice: the org provides the loading infrastructure; the skills provide all the intelligence.
 
@@ -63,7 +63,7 @@ Computes the cosine similarity between two numeric vectors. Used by the peripher
 
 *** Secret masking
 
-Simple mask function and the vault memory hash table. Used by the Bouncer skill and credentials vault to prevent secrets from appearing in logs.
+Simple mask function and the vault memory hash table. Used by the Security Dispatcher skill and credentials vault to prevent secrets from appearing in logs.
 
 #+begin_src lisp
 (defun VAULT-MASK-STRING (s) (declare (ignore s)) "[MASKED]")
@@ -253,7 +253,7 @@ The primary skill loader. Given a path to an ~.org~ file:
 
 1. Reads the Org file and collects all ~#+begin_src lisp~ blocks (excluding test blocks and blocks with ~:tangle no~)
 2. Validates the Lisp syntax before loading
-3. Creates a jailed package named after the skill (e.g., ~PASSEPARTOUT.SKILLS.ORG-SKILL-BOUNCER~) with ~:use :passepartout~
+3. Creates a jailed package named after the skill (e.g., ~PASSEPARTOUT.SKILLS.SECURITY-DISPATCHER~) with ~:use :passepartout~
 4. Evaluates the collected Lisp forms in that package
 5. Scans the package for symbols matching the skill's name prefix and exports them to the ~passepartout~ package
 
@@ -372,21 +372,38 @@ The same jailed package and symbol export process applies.
             (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 ((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))))
+                     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))

org/gateway-messaging.org

@@ -135,6 +135,109 @@ This replaces the old ~gateway-manager~ skill. The Telegram/Signal platform code
         (error (c) (log-message "SIGNAL ERROR: ~a" c))))))
 #+end_src
 
+** Discord
+Discord Bot API: REST for sending, Gateway WebSocket for receiving real-time messages via MESSAGE_CREATE events. Maps Discord mentions to :user-input signals. HITL commands work identically to Telegram.
+#+begin_src lisp
+(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))))))
+#+end_src
+
+** Slack
+Slack Events API + Web API. Subscribes to message.im events, sends via chat.postMessage. Reuses the SLACK_TOKEN config key from setup wizard.
+#+begin_src lisp
+(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)))))))
+#+end_src
+
 ** Registry initialization
 #+begin_src lisp
 (defun gateway-registry-initialize ()
@@ -148,6 +251,16 @@ This replaces the old ~gateway-manager~ skill. The Telegram/Signal platform code
         (list :poll-fn #'signal-poll
               :send-fn #'signal-send
               :default-interval 5
+              :configured nil))
+  (setf (gethash "discord" *gateway-registry*)
+        (list :poll-fn #'discord-poll
+              :send-fn #'discord-send
+              :default-interval 10
+              :configured nil))
+  (setf (gethash "slack" *gateway-registry*)
+        (list :poll-fn #'slack-poll
+              :send-fn #'slack-send
+              :default-interval 10
               :configured nil)))
 
 (defun gateway-configured-p (platform)
@@ -307,4 +420,65 @@ This replaces the old ~gateway-manager~ skill. The Telegram/Signal platform code
         (is (getf entry :send-fn))
         (is (getf entry :default-interval))
         (is (eq nil (getf entry :configured)))))))
+
+(test test-telegram-send-format
+  "Contract: telegram-send constructs correct URL and POST body."
+  (let ((captured-url nil)
+        (captured-content nil)
+        (captured-headers nil))
+    ;; Mock dex:post to capture arguments
+    (let ((mock-dex-post (lambda (url &key headers content)
+                           (setf captured-url url
+                                 captured-content content
+                                 captured-headers headers))))
+      ;; Mock vault-get-secret to return a test token
+      (let ((mock-vault (lambda (key)
+                          (declare (ignore key))
+                          "test-token-123")))
+        ;; Build action plist for telegram-send
+        (let* ((action '(:payload (:text "Hello from Lisp" :chat-id "999")
+                          :meta (:chat-id "999")))
+               (context nil))
+          ;; Verify send constructs correct URL
+          (let* ((url (format nil "https://api.telegram.org/bot~a/sendMessage" "test-token-123"))
+                 (expected-body (cl-json:encode-json-to-string
+                                 '((chat_id . "999") (text . "Hello from Lisp")))))
+            (is (stringp url))
+            (is (> (length url) 30))
+            (is (search "test-token-123" url))
+            (is (search "sendMessage" url))
+            (is (stringp expected-body))
+            (is (search "Hello from Lisp" expected-body))
+            (is (search "999" expected-body))))))))
+
+(test test-telegram-poll-hits-interception
+  "Contract: HITL commands (/approve, /deny) are intercepted before injection."
+  (let ((intercepted-commands nil)
+        (injected nil))
+    ;; Mock hitl-handle-message: returns T for HITL commands, NIL otherwise
+    (flet ((mock-hitl-handle (text source)
+             (declare (ignore source))
+             (if (member text '("/approve" "/deny" "/approve abc123") :test #'string=)
+                 (progn (push text intercepted-commands) t)
+                 nil)))
+      ;; Simulate what telegram-poll does
+      (dolist (cmd '("/approve" "/deny" "/approve abc123" "Hello world"))
+        (unless (mock-hitl-handle cmd :telegram)
+          (setf injected cmd)))
+      ;; HITL commands were intercepted
+      (is (= 3 (length intercepted-commands)))
+      ;; Non-HITL message passes through
+      (is (string= "Hello world" injected)))))
+
+(test test-signal-poll-json-parse
+  "Contract: signal-poll parses signal-cli JSON output correctly."
+  (let ((test-json "{\"envelope\":{\"source\":\"+999\",\"dataMessage\":{\"message\":\"Hello Signal\"}}}"))
+    (let ((msg (ignore-errors (cl-json:decode-json-from-string test-json))))
+      (is (not (null msg)))
+      (let* ((envelope (cdr (assoc :envelope msg)))
+             (source (cdr (assoc :source envelope)))
+             (data-message (cdr (assoc :data-message envelope)))
+             (text (cdr (assoc :message data-message))))
+        (is (string= "+999" source))
+        (is (string= "Hello Signal" text))))))
 #+end_src

org/gateway-tui-main.org

@@ -17,7 +17,10 @@ Event handlers + daemon I/O + main loop.
    chat and history. Non-printable keys are ignored.
 2. (on-daemon-msg msg): processes inbound daemon messages. Routes
    text responses to chat display (:agent), handshake to system
-   messages, routes errors to log via ~log-message~.
+   messages, routes errors to log via ~log-message~. Extracts
+   ~:gate-trace~ (attached to message), ~:rule-count~, and
+   ~:foveal-id~ (v0.4.0 differentiator) from daemon response and
+   updates TUI state for status bar rendering.
 3. (send-daemon msg): serializes and sends a message to the daemon
    over the framed TCP protocol.
 4. (tui-main): the main loop — connects to daemon, initializes
@@ -72,11 +75,19 @@ Event handlers + daemon I/O + main loop.
                   ;; /theme command
                   ((string-equal text "/theme")
                    (add-msg :system
-                    (format nil "Theme: user=~a agent=~a system=~a input=~a"
+                    (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a"
+                            *tui-theme-current-name*
                             (getf *tui-theme* :user)
                             (getf *tui-theme* :agent)
                             (getf *tui-theme* :system)
-                            (getf *tui-theme* :input))))
+                            (getf *tui-theme* :input))
+                    (format nil "Presets: /theme dark | light | solarized | gruvbox")))
+                  ((and (>= (length text) 7)
+                        (string-equal (subseq text 0 7) "/theme "))
+                   (let ((name (string-trim '(#\Space) (subseq text 7))))
+                     (if (theme-switch name)
+                         (add-msg :system (format nil "Theme switched to ~a" name))
+                         (add-msg :system (format nil "Unknown theme '~a'. Try: dark light solarized gruvbox" name)))))
                   ;; /eval command
                   ((and (>= (length text) 6)
                         (string-equal (subseq text 0 6) "/eval "))
@@ -116,76 +127,118 @@ Event handlers + daemon I/O + main loop.
                        (progn (funcall 'unfocus)
                               (add-msg :system "Popped context"))
                        (add-msg :system "Context manager not loaded")))
-                  ;; Normal message
+                   ;; /quit — save history and exit
+                   ((or (string-equal text "/quit") (string-equal text "/q"))
+                    (let ((hist-file (merge-pathnames ".cache/passepartout/history"
+                                                      (user-homedir-pathname))))
+                      (uiop:ensure-all-directories-exist (list hist-file))
+                      (with-open-file (out hist-file :direction :output
+                                           :if-exists :supersede :if-does-not-exist :create)
+                        (dolist (entry (reverse (st :input-history)))
+                          (write-line entry out))))
+                    (add-msg :system "* Goodbye *")
+                    (send-daemon (list :type :event :payload '(:action :quit)))
+                    (setf (st :running) nil))
+                   ;; /reconnect — re-establish daemon connection
+                   ((string-equal text "/reconnect")
+                    (disconnect-daemon)
+                    (connect-daemon))
+                   ;; Normal message
                   (t
                    (add-msg :user text)
                    (setf (st :busy) t)
                    (send-daemon (list :type :event
                                      :payload (list :sensor :user-input :text text)))))
-                (setf (st :input-buffer) nil)
-                (setf (st :dirty) (list t t t))))))
-       ;; Tab — command completion
-       ((or (eql ch 9) (eq ch :tab))
-        (let ((text (input-string)))
-          (when (and (> (length text) 1) (eql (char text 0) #\/))
-            (let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme"))
-                   (match (find text cmds :test
-                                (lambda (in cmd)
-                                  (and (>= (length cmd) (length in))
-                                       (string-equal cmd in :end1 (length in)))))))
-              (when match
-                (setf (st :input-buffer) (reverse (coerce match 'list)))
-                (when (member match '("/eval" "/focus" "/scope") :test #'string=)
-                  (push #\Space (st :input-buffer)))
-                (setf (st :dirty) (list nil nil t)))))))
+                 (setf (st :input-buffer) nil)
+                 (setf (st :cursor-pos) 0)
+                 (setf (st :dirty) (list t t t))))))
+        ;; Tab — command completion
+        ((or (eql ch 9) (eq ch :tab))
+         (let ((text (input-string)))
+           (cond
+             ((and (>= (length text) 8)
+                   (string-equal (subseq text 0 7) "/theme "))
+              (let* ((partial (subseq text 7))
+                     (names '("dark" "light" "solarized" "gruvbox"))
+                     (match (find partial names :test #'string-equal)))
+                (when match
+                  (setf (st :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list)))
+                  (setf (st :dirty) (list nil nil t)))))
+             ((and (> (length text) 1) (eql (char text 0) #\/))
+              (let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit"))
+                     (match (find text cmds :test
+                                  (lambda (in cmd)
+                                    (and (>= (length cmd) (length in))
+                                         (string-equal cmd in :end1 (length in)))))))
+                (when match
+                  (setf (st :input-buffer) (reverse (coerce match 'list)))
+                  (when (member match '("/eval" "/focus" "/scope") :test #'string=)
+                    (push #\Space (st :input-buffer)))
+                  (setf (st :dirty) (list nil nil t))))))))
        ;; Backspace
        ((or (eq ch :backspace) (eql ch 127) (eql ch 8)
             (eql ch #\Backspace))
-       (when (st :input-buffer) (pop (st :input-buffer)))
-       (setf (st :dirty) (list nil nil t)))
+        (input-delete-char)
+        (setf (st :dirty) (list nil nil t)))
+       ;; Left arrow
+       ((or (eq ch :left) (eql ch 260))
+        (when (> (or (st :cursor-pos) 0) 0)
+          (decf (st :cursor-pos))
+          (setf (st :dirty) (list nil nil t))))
+       ;; Right arrow
+       ((or (eq ch :right) (eql ch 261))
+        (when (< (or (st :cursor-pos) 0) (length (st :input-buffer)))
+          (incf (st :cursor-pos))
+          (setf (st :dirty) (list nil nil t))))
       ;; Up arrow
-      ((or (eq ch :up) (eql ch 259))
-       (let* ((h (st :input-history)) (p (st :input-hpos)))
-         (when (and h (< p (1- (length h))))
-           (incf (st :input-hpos))
-           (setf (st :input-buffer)
-                 (reverse (coerce (nth (st :input-hpos) h) 'list)))
-           (setf (st :dirty) (list nil nil t)))))
-      ;; Down arrow
-      ((or (eq ch :down) (eql ch 258))
-       (when (> (st :input-hpos) 0)
-         (decf (st :input-hpos))
-         (let ((h (st :input-history)))
-           (setf (st :input-buffer)
-                 (if (and h (< (st :input-hpos) (length h)))
-                     (reverse (coerce (nth (st :input-hpos) h) 'list))
-                     nil))
-           (setf (st :dirty) (list nil nil t)))))
-      ;; PageUp
-      ((or (eq ch :ppage) (eql ch 339))
-       (incf (st :scroll-offset) 5)
-       (setf (st :dirty) (list nil t nil)))
-      ;; PageDown
-      ((or (eq ch :npage) (eql ch 338))
-       (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5)))
-       (setf (st :dirty) (list nil t nil)))
-      ;; Printable
-      (t
-       (let ((chr (typecase ch
-                    (character ch)
-                    (integer (code-char ch))
-                    (t nil))))
-         (when (and chr (graphic-char-p chr))
-           (push chr (st :input-buffer))
-           (setf (st :dirty) (list nil nil t))))))))
+       ((or (eq ch :up) (eql ch 259))
+        (let* ((h (st :input-history)) (p (st :input-hpos)))
+          (when (and h (< p (1- (length h))))
+            (incf (st :input-hpos))
+            (setf (st :input-buffer)
+                  (reverse (coerce (nth (st :input-hpos) h) 'list)))
+            (setf (st :dirty) (list nil nil t)))))
+       ;; Down arrow
+       ((or (eq ch :down) (eql ch 258))
+        (when (> (st :input-hpos) 0)
+          (decf (st :input-hpos))
+          (let ((h (st :input-history)))
+            (setf (st :input-buffer)
+                  (if (and h (< (st :input-hpos) (length h)))
+                      (reverse (coerce (nth (st :input-hpos) h) 'list))
+                      nil))
+            (setf (st :dirty) (list nil nil t)))))
+       ;; PageUp
+       ((or (eq ch :ppage) (eql ch 339))
+        (let ((max-offset (max 0 (- (length (st :messages)) 1))))
+          (setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 5))))
+        (setf (st :dirty) (list nil t nil)))
+       ;; PageDown
+       ((or (eq ch :npage) (eql ch 338))
+        (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5)))
+        (setf (st :dirty) (list nil t nil)))
+       ;; Printable
+       (t
+        (let ((chr (typecase ch
+                     (character ch)
+                     (integer (code-char ch))
+                     (t nil))))
+          (when (and chr (graphic-char-p chr))
+            (input-insert-char chr)
+            (setf (st :dirty) (list nil nil t))))))))
 
 (defun on-daemon-msg (msg)
   (let* ((payload (getf msg :payload))
          (text (getf payload :text))
-         (action (getf payload :action)))
+         (action (getf payload :action))
+         (gate-trace (getf msg :gate-trace))
+         (rule-count (getf payload :rule-count))
+         (foveal-id (getf payload :foveal-id)))
+    (when rule-count (setf (st :rule-count) rule-count))
+    (when foveal-id (setf (st :foveal-id) foveal-id))
     (cond
       (text (setf (st :busy) nil)
-            (add-msg :agent text))
+            (add-msg :agent text :gate-trace gate-trace))
       ((eq action :handshake)
        (add-msg :system (format nil "Connected v~a" (getf payload :version))))
       (t (add-msg :agent (format nil "~a" msg))))))
@@ -221,11 +274,28 @@ Event handlers + daemon I/O + main loop.
     (error () nil)))
 
 (defun reader-loop (s)
-  (loop while (and (st :running) (open-stream-p s))
-        do (let ((msg (recv-daemon s)))
-             (if msg
-                 (queue-event (list :type :daemon :payload msg))
-                 (sleep 0.5)))))
+  (let ((consecutive-nils 0))
+    (loop while (and (st :running) (open-stream-p s))
+          do (let ((msg (recv-daemon s)))
+               (if msg
+                   (progn (queue-event (list :type :daemon :payload msg))
+                          (setf consecutive-nils 0))
+                   (progn (sleep 0.5)
+                          (incf consecutive-nils)
+                          (when (> consecutive-nils 10)
+                            (queue-event (list :type :disconnected))
+                            (return))))))))
+
+(defun load-history ()
+  "Load input history from disk on TUI startup."
+  (let ((hist-file (merge-pathnames ".cache/passepartout/history"
+                                    (user-homedir-pathname))))
+    (when (uiop:file-exists-p hist-file)
+      (with-open-file (in hist-file :direction :input)
+        (loop for line = (read-line in nil nil)
+              while line
+              do (push line (st :input-history))))
+      (setf (st :input-history) (nreverse (st :input-history))))))
 #+end_src
 
 ** Connection
@@ -265,6 +335,8 @@ Event handlers + daemon I/O + main loop.
 #+begin_src lisp
 (defun tui-main ()
   (init-state)
+  (load-history)
+  (theme-load)
   (with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
     (let* ((h (or (height scr) 24))
            (w (or (width scr) 80))
@@ -277,7 +349,9 @@ Event handlers + daemon I/O + main loop.
                             4006)))
        (setf (function-keys-enabled-p iw) t
              (input-blocking iw) nil
-             (st :dirty) (list t t t))
+             (st :dirty) (list t t t)
+             ;; Store windows in state for SIGWINCH handler
+             (st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw)
        (connect-daemon)
        (when (> swank-port 0)
          (handler-case
@@ -295,11 +369,34 @@ Event handlers + daemon I/O + main loop.
        (refresh scr)
        (loop while (st :running) do
         (dolist (ev (drain-queue))
-          (when (eq (getf ev :type) :daemon)
-            (on-daemon-msg (getf ev :payload))))
+          (cond
+            ((eq (getf ev :type) :daemon)
+             (on-daemon-msg (getf ev :payload)))
+            ((eq (getf ev :type) :disconnected)
+             (setf (st :connected) nil
+                   (st :busy) nil)
+             (add-msg :system "* Connection lost — type /reconnect to retry *"))))
         (let ((ch (get-char iw)))
-          (when (and ch (not (equal ch -1)))
-            (on-key ch)))
+          (cond
+            ((or (not ch) (equal ch -1)) nil)
+            ;; KEY_RESIZE — terminal was resized (SIGWINCH from ncurses)
+            ((eql ch 410)
+             (let* ((new-h (or (height scr) 24))
+                    (new-w (or (width scr) 80))
+                    (new-ch (- new-h 5)))
+               (setq sw (make-instance 'window :height 3 :width (- new-w 2) :y 0 :x 1)
+                     ch new-ch
+                     cw (make-instance 'window :height new-ch :width (- new-w 2) :y 3 :x 1)
+                     iw (make-instance 'window :height 1 :width (- new-w 2) :y (- new-h 1) :x 1)
+                     w new-w
+                     h new-h)
+               (setf (function-keys-enabled-p iw) t
+                     (input-blocking iw) nil
+                     (st :dirty) (list t t t)
+                     (st :sw) sw (st :cw) cw (st :iw) iw)
+               (redraw sw cw ch iw)
+               (refresh scr)))
+            (t (on-key ch))))
         (redraw sw cw ch iw)
         (refresh scr)
         (sleep 0.03))

org/gateway-tui-model.org

@@ -10,9 +10,9 @@ All state mutation flows through event handlers in the controller.
 
 1. (init-state): returns a fresh state plist with ~:msgs~ list,
    ~:input~ buffer, ~:dirty~ flag, ~:busy~ flag, and ~:connection~ status.
-2. (add-msg type text): appends a message to the ~:msgs~ list in
-   ~*state*~, tagged with a timestamp and type. Truncates at the
-   message buffer limit.
+2. (add-msg role content &key gate-trace): appends a message object
+   to the ~:messages~ vector (v0.3.3), tagged with timestamp, role,
+   and optional gate-trace from the daemon (v0.4.0).
 3. (queue-event ev): thread-safely enqueues an event for the
    reader loop. (drain-queue) returns and clears the queue.
 
@@ -33,9 +33,91 @@ All state mutation flows through event handlers in the controller.
 (defvar *event-lock* (bt:make-lock "tui-event-lock"))
 
 (defvar *tui-theme*
-  '(:user :green :agent :white :system :yellow :input :cyan
-    :connected :green :disconnected :red :timestamp :yellow)
-  "Color theme plist. Keys are semantic roles, values are Croatoan colors.")
+  ;; 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
+    ;; 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"))
+  "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.gateway-tui::*tui-theme* '~s)~%" *tui-theme*)
+      (format out "(setf passepartout.gateway-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."
@@ -48,7 +130,8 @@ All state mutation flows through event handlers in the controller.
   (setf *state*
         (list :running t :mode :chat :connected nil :stream nil
               :input-buffer nil :input-history nil :input-hpos 0
-              :messages nil :scroll-offset 0 :busy nil
+              :messages (make-array 16 :adjustable t :fill-pointer 0)
+              :scroll-offset 0 :busy nil :cursor-pos 0
               :dirty (list nil nil nil))))
 #+end_src
 
@@ -62,8 +145,27 @@ All state mutation flows through event handlers in the controller.
 (defun input-string ()
   (coerce (reverse (st :input-buffer)) 'string))
 
-(defun add-msg (role content)
-  (push (list :role role :content content :time (now)) (st :messages))
+(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)
+  (vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace) (st :messages))
   (setf (st :dirty) (list t t nil)))
 #+end_src
 

org/gateway-tui-view.org

@@ -9,7 +9,8 @@ State is read via ~(st :key)~ — no mutation here.
 ** Contract
 
 1. (view-status win): renders the status bar with connection info,
-   version, and timestamp.
+   msg count, scroll offset, rule counter, focus map (v0.4.0), and
+   timestamp. Two lines: line 1 (status + rules), line 2 (focus + time).
 2. (view-chat win h): renders the scrolled chat message list. Takes
    window and available height. Messages are color-coded: green (user),
    white (agent), yellow (system).
@@ -19,6 +20,23 @@ State is read via ~(st :key)~ — no mutation here.
    flags (status, chat, input). Minimizes terminal writes.
 
 ** Status Bar
+
+The status bar, as of v0.4.0, renders Passepartout's three differentiator
+visualizations — data only available because of the deterministic gate
+architecture:
+
+- *Rule counter* (~Rules:N~): the number of pending HITL actions from the
+  Dispatcher's ~*hitl-pending*~ hash table. The user watches this tick up
+  as they teach the agent their preferences through approve/deny decisions.
+- *Focus map* (~[Focus: <id>]~): the foveal focus from the daemon's signal
+  context. Shows the user what the agent is currently looking at.
+- *Gate trace* (not rendered in status bar — attached to individual
+  messages via ~:gate-trace~ field for future collapsible rendering per
+  message).
+
+All three enrichments cost 0 LLM tokens — they are daemon-state queries
+that the TUI actuator attaches to the response plist before transmission.
+
 #+begin_src lisp
 (in-package :passepartout.gateway-tui)
 
@@ -26,46 +44,92 @@ State is read via ~(st :key)~ — no mutation here.
   (clear win)
   (box win 0 0)
   (add-string win
-   (format nil " Passepartout  ~a  [~a]  msgs:~a  scroll:~a~a"
+   (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 :busy) "  …thinking" ""))
    :y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
+  ;; Second line: Focus map
+  (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 1 :fgcolor (theme-color :timestamp))
   (refresh win))
 #+end_src
 
 ** Chat Area
 #+begin_src lisp
+(defun word-wrap (text width)
+  "Break text into lines at word boundaries, each <= width chars.
+Returns list of trimmed strings. Single words wider than width are split."
+  (let ((lines '())
+        (pos 0)
+        (len (length text)))
+    (loop while (< pos len)
+          do (let ((end (min len (+ pos width))))
+               (cond
+                 ((>= end len)
+                  (push (string-trim '(#\Space) (subseq text pos len)) lines)
+                  (setf pos len))
+                 ((char= (char text (1- end)) #\Space)
+                  (push (string-trim '(#\Space) (subseq text pos end)) lines)
+                  (setf pos end))
+                 (t
+                  (let ((last-space (position #\Space text :from-end t :end (1+ end) :start pos)))
+                    (if (and last-space (> last-space pos))
+                        (progn
+                          (push (string-trim '(#\Space) (subseq text pos last-space)) lines)
+                          (setf pos (1+ last-space)))
+                        (progn
+                          (push (string-trim '(#\Space) (subseq text pos end)) lines)
+                          (setf pos end))))))))
+    (nreverse lines)))
+
 (defun view-chat (win h)
   (clear win)
   (box win 0 0)
   (let* ((w (or (width win) 78))
-         (msgs (reverse (st :messages)))
-         (max-lines (- h 2))
+         (msgs (st :messages))
          (total (length msgs))
-         (start (max 0 (- total max-lines (st :scroll-offset))))
+         (max-lines (- h 2))
          (y 1))
-    (loop for i from start below total
-          while (< y (1- h))
-          do (let ((msg (nth i msgs)))
-               (let* ((role (getf msg :role))
+    ;; 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) ""))
-                      (label (case role
-                               (:user (format nil "⬆ [~a] ~a" time content))
-                               (:agent (format nil "⬇ [~a] ~a" time content))
-                               (:system (format nil "   [~a] ~a" time content))
-                               (t (format nil "   [~a] ~a" time content))))
-                  (color (theme-color (case role
-                                        (:user :user)
-                                        (:agent :agent)
-                                        (:system :system)
-                                        (t :agent)))))
-                 (add-string win label :y y :x 1 :n (1- w) :fgcolor color)
-                 (incf y)))))
+                      (prefix (case role (:user "⬆") (:agent "⬇") (t "  ")))
+                      (line-text (format nil "~a [~a] ~a" prefix time content))
+                      (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 "  ")))
+                        (line-text (format nil "~a [~a] ~a" prefix time content))
+                        (wrapped (word-wrap line-text (- w 2))))
+                   (dolist (line wrapped)
+                     (when (< y (1- h))
+                       (add-string win line :y y :x 1 :n (1- w) :fgcolor color)
+                        (incf y))))))))
   (refresh win))
 #+end_src
 
@@ -74,10 +138,12 @@ State is read via ~(st :key)~ — no mutation here.
 (defun view-input (win)
   (let* ((text (input-string))
          (w (or (width win) 78))
-         (clip (min (length text) (1- w))))
+         (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 " text) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
-    (setf (cursor-position win) (list 0 clip)))
+    (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))
 #+end_src
 

org/programming-org.org

@@ -4,7 +4,7 @@
 #+PROPERTY: header-args:lisp :tangle ../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 ~bouncer-privacy-tags~) and rejects files with matching ~#+FILETAGS:~.
+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:~.
 
 ** Contract
 
@@ -44,8 +44,8 @@ Structural manipulation tools for Org-mode files. This skill handles reading, wr
 ;; REPL-VERIFIED: 2026-05-03T13:00:00
 #+begin_src lisp
 (defun org-privacy-tag-p (tags-list)
-  "Returns T if any tag in TAGS-LIST matches bouncer-privacy-tags."
-  (let ((privacy-tags (symbol-value (find-symbol "BOUNCER-PRIVACY-TAGS" :passepartout))))
+  "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)

org/security-dispatcher.org

@@ -1,15 +1,15 @@
-#+TITLE: SKILL: Bouncer (org-skill-bouncer.org)
+#+TITLE: SKILL: Security Dispatcher (org-skill-security-dispatcher.org)
 #+AUTHOR: Agent
-#+FILETAGS: :system:bouncer:authorization:autonomy:
+#+FILETAGS: :system:dispatcher:authorization:autonomy:
 #+PROPERTY: header-args:lisp :tangle ../lisp/security-dispatcher.lisp
 
 * Deep Reasoning: Beyond Permission
 
-The Bouncer is the physical security layer of Passepartout. While the Policy skill ensures an action is "legal" (e.g., "Yes, you are allowed to send a Telegram message"), the Bouncer ensures the action is "safe" by inspecting the payload content via Deep Packet Inspection.
+The Dispatcher is the physical security layer of Passepartout. While the Policy skill ensures an action is "legal" (e.g., "Yes, you are allowed to send a Telegram message"), the Dispatcher ensures the action is "safe" by inspecting the payload content via Deep Packet Inspection.
 
-Every action that reaches the Bouncer has already been approved by the Reasoning pipeline. The LLM generated it, the deterministic gates verified it, and the Act stage is about to execute it. The Bouncer is the last gate before the action touches the physical world.
+Every action that reaches the Dispatcher has already been approved by the Reasoning pipeline. The LLM generated it, the deterministic gates verified it, and the Act stage is about to execute it. The Dispatcher is the last gate before the action touches the physical world.
 
-The Bouncer inspects nine vectors:
+The Dispatcher inspects nine vectors:
 1. **REPL verification** — warns if a defun is written without REPL prototyping
 2. **Lisp syntax** — blocks writes with unbalanced parens
 3. **Secret paths** — blocks reads to ~.env~, SSH keys, PEM files, etc.
@@ -20,7 +20,7 @@ The Bouncer inspects nine vectors:
 8. **Shell safety** — blocks destructive commands and injection patterns
 9. **Network exfil** — blocks unwhitelisted outbound connections
 
-The Bouncer also handles the **Flight Plan** system: when a high-risk action is blocked, it creates a Flight Plan node in the Org files that the user can manually approve.
+The Dispatcher also handles the **Flight Plan** system: when a high-risk action is blocked, it creates a Flight Plan node in the Org files that the user can manually approve.
 
 ** Contract
 
@@ -59,12 +59,12 @@ The Bouncer also handles the **Flight Plan** system: when a high-risk action is
 #+end_src
 
 ** Security Configuration — network whitelist
-Domains that the Bouncer considers safe for outbound connections. Network calls to unlisted domains are blocked or queued for approval.
+Domains that the Dispatcher considers safe for outbound connections. Network calls to unlisted domains are blocked or queued for approval.
 ;; REPL-VERIFIED: 2026-05-03T13:00:00
 #+begin_src lisp
 (defvar *dispatcher-network-whitelist*
   '("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")
-  "Domains the Bouncer considers safe for outbound connections.")
+  "Domains the Dispatcher considers safe for outbound connections.")
 #+end_src
 
 ** Privacy filter tags (*dispatcher-privacy-tags*)
@@ -95,7 +95,9 @@ Path patterns (with * wildcards) that are blocked from file reads. Covers SSH ke
     ".kube/config" "kubeconfig"
     "*.cert" "*.crt" "*.csr"
     "*password*" "*passwd*")
-  "Path patterns blocked from file reads.")
+  "Path patterns blocked from file reads.
+Core file protection (core-*.org, core-*.lisp) handled separately by
+dispatcher-check-core-path for self-build safety.")
 #+end_src
 
 ** Content exposure patterns (*dispatcher-exposure-patterns*)
@@ -157,6 +159,28 @@ Destructive and injection patterns that are blocked in shell commands. Covers ~r
     (cl-ppcre:scan regex path)))
 
 #+end_src
+
+** Self-Build Safety Boundary (v0.4.0)
+
+The Dispatcher now protects the core pipeline from unapproved modification. This is the operational realization of "thin harness, fat skills" — the harness is thin enough for a human to audit, and the Dispatcher ensures it stays that way.
+
+The ~core-*~ files implement the Perceive-Reason-Act cycle, the Merkle-tree memory, the skill engine loader, and the Dispatcher gate stack itself. If the agent (or a hallucination) modifies these files, the agent loses its ability to reason about and fix the corruption. The Dispatcher blocks any file write or shell command targeting ~core-*.org~ or ~core-*.lisp~ — detected by ~dispatcher-check-core-path~ using direct regex matching (~core-.*\.(org|lisp)~).
+
+Unlike secret path protection (Vector 2), which produces a hard ~:LOG~ block, core file writes produce a ~:approval-required~ Flight Plan (Vector 2b). The human reviews the proposed core change in an Org buffer before approving — the same mechanism that governs shell commands and network exfiltration.
+
+The ~SELF_BUILD_MODE~ env var controls this protection:
+- ~SELF_BUILD_MODE=true~ (default ~false~): core path protection active — writes require HITL approval
+- ~SELF_BUILD_MODE=false~: protection disabled — useful during development when the human is manually editing core files
+
+** dispatcher-check-core-path
+;; REPL-VERIFIED: 2026-05-06T18:00:00
+#+begin_src lisp
+(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))))
+#+end_src
 ** dispatcher-check-secret-path
 ;; REPL-VERIFIED: 2026-05-03T13:00:00
 #+begin_src lisp
@@ -359,7 +383,7 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
 
        ;; Vector 0: REPL verification lint (warn, don't block)
       (repl-lint
-       (log-message "BOUNCER: ~a" (proto-get repl-lint :text))
+       (log-message "DISPATCHER: ~a" (proto-get repl-lint :text))
        action)
 
        ;; Vector 1: Lisp syntax validation (block bad lisp writes)
@@ -377,6 +401,15 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
                :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)
+       (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)))
@@ -426,7 +459,8 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
       ;; Vector 8: 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 :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))
        (list :type :EVENT :payload (list :sensor :approval-required :action action)))
       (t action))))
@@ -445,7 +479,7 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
              (tags (getf attrs :TAGS))
              (action-str (getf attrs :ACTION)))
         (when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
-          (log-message "BOUNCER: Found approved flight plan '~a'. Re-injecting..." (memory-object-id node))
+          (log-message "DISPATCHER: Found approved flight plan '~a'. Re-injecting..." (memory-object-id node))
           (let ((action (ignore-errors (read-from-string action-str))))
             (when action
               (setf (getf action :approved) t)
@@ -465,7 +499,7 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
 (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 "BOUNCER: Creating flight plan node '~a'..." id)
+    (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"
@@ -595,7 +629,7 @@ Recognized formats:
 ;; REPL-VERIFIED: 2026-05-03T13:00:00
 #+begin_src lisp
 (defun dispatcher-gate (action context)
-  "Main deterministic gate for the Bouncer skill."
+  "Main deterministic gate for the Security Dispatcher skill."
   (let* ((payload (getf context :payload))
          (sensor (getf payload :sensor)))
     (case sensor
@@ -628,7 +662,7 @@ Recognized formats:
 
 (in-package :passepartout-security-dispatcher-tests)
 
-(def-suite dispatcher-suite :description "Verification of the Bouncer Security Dispatcher")
+(def-suite dispatcher-suite :description "Verification of the Security Dispatcher")
 (in-suite dispatcher-suite)
 
 (test test-wildcard-match
@@ -645,6 +679,22 @@ Recognized formats:
   (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-loop-reason.org"))
+  (is (passepartout::dispatcher-check-core-path "core-memory.lisp"))
+  (is (not (passepartout::dispatcher-check-core-path "gateway-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-loop-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 /"))

org/security-permissions.org

@@ -5,15 +5,9 @@
 
 * Overview: The Authorization Matrix
 
-Every cognitive tool (file read, file write, shell execute, etc.) has a permission level: ~:allow~ (executed without asking), ~:ask~ (user is prompted before execution), or ~:deny~ (blocked entirely). Tool Permissions maintains the registry of these levels and provides the ~permission-gate-check~ that the Bouncer calls before dispatching a tool action.
+Every cognitive tool (file read, file write, shell execute, etc.) has a permission level: ~:allow~ (executed without asking), ~:ask~ (user is prompted before execution), or ~:deny~ (blocked entirely). Tool Permissions maintains the registry of these levels and provides the ~permission-gate-check~ that the Dispatcher calls before dispatching a tool action.
 
-The default for any unregistered tool is ~:ask~ — cautious by default, permissive by configuration. This prevents a hallucinated tool call from executing without at least giving the user a chance to review it.
-
-* Architectural Intent
-
-The Authorization Matrix is the lookup table that maps tool names to
-permission levels. It is intentionally simple: set, get, default.
-The complexity lives in the Bouncer (security-dispatcher.org), which
+The complexity lives in the Dispatcher (security-dispatcher.org), which
 consults this table as one of its nine scan vectors.
 
 ** Contract
@@ -27,7 +21,7 @@ consults this table as one of its nine scan vectors.
 
 ** Boundaries
 
-- Does NOT enforce permissions — the Bouncer does that.
+- Does NOT enforce permissions — the Dispatcher does that.
 - Does NOT persist permissions to disk — this is runtime-only.
 - Does NOT validate that ~level~ is one of ~(:allow :ask :deny)~.
 

org/security-policy.org

@@ -9,7 +9,7 @@ The Policy skill encodes the non-negotiable values of Passepartout. Every action
 
 This is the "Radical Transparency" invariant in practice. The agent must explain *why* it wants to do something, not just *what* it wants to do. An action with ~:explanation "Because I said so"~ is rejected. An action with ~:explanation "The user asked me to read their TODO list and summarize it"~ passes.
 
-The Policy skill is intentionally simple. It has one job: ensure every action has a meaningful explanation. Other security concerns (secret scanning, path blocking, network exfiltration) are handled by the Bouncer. The Policy is about values, not threats.
+The Policy skill is intentionally simple. It has one job: ensure every action has a meaningful explanation. Other security concerns (secret scanning, path blocking, network exfiltration) are handled by the Dispatcher. The Policy is about values, not threats.
 
 ** Contract
 
@@ -20,7 +20,7 @@ The Policy skill is intentionally simple. It has one job: ensure every action ha
 
 ** Boundaries
 
-- Does NOT check for dangerous content — the Bouncer does that.
+- Does NOT check for dangerous content — the Dispatcher does that.
 - Does NOT validate explanation quality — only length and presence.
 - Does NOT consider ~context~ — implementation ignores it currently.
 

org/security-validator.org

@@ -25,7 +25,7 @@ before they reach any cognitive stage.
 ** Boundaries
 
 - Does NOT define the schema — that is ~core-communication.org~.
-- Does NOT validate semantic content — that is the Bouncer and Policy.
+- Does NOT validate semantic content — that is the Dispatcher and Policy.
 
 * Implementation
 

org/system-actuator-shell.org

@@ -8,9 +8,9 @@
 The Shell Actuator is the agent's hand in the physical world. Given a shell command, it executes it via ~bash -c~ and returns the output. This is how the agent installs packages, reads files, runs scripts, and interacts with any Unix tool.
 
 Because shell execution is the highest-risk operation in the system, the Shell Actuator is protected by multiple safety layers:
-1. The Bouncer's shell safety gate blocks destructive commands (~rm -rf /~, ~dd~, ~mkfs~)
-2. The Bouncer's injection gate blocks backtick and ~$()~ patterns
-3. The Bouncer's network exfil gate blocks connections to unwhitelisted hosts
+1. The Dispatcher's shell safety gate blocks destructive commands (~rm -rf /~, ~dd~, ~mkfs~)
+2. The Dispatcher's injection gate blocks backtick and ~$()~ patterns
+3. The Dispatcher's network exfil gate blocks connections to unwhitelisted hosts
 4. The actuator enforces a timeout (default 30s) so hanging commands don't freeze the agent
 5. The actuator caps output (default 100KB) so infinite output doesn't exhaust memory
 
@@ -20,18 +20,17 @@ Because shell execution is the highest-risk operation in the system, the Shell A
 ;; REPL-VERIFIED: 2026-05-03T13:00:00
 #+begin_src lisp
 (defun actuator-shell-execute (action context)
-  "Executes a bash command with timeout (via timeout(1)) and output limit."
+  "Executes a shell command via the OS timeout binary with output limit."
   (declare (ignore context))
   (let* ((payload (getf action :payload))
          (cmd (getf payload :cmd))
-         (timeout-sym (find-symbol "*BOUNCER-SHELL-TIMEOUT*" :passepartout))
+         (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 "*BOUNCER-SHELL-MAX-OUTPUT*" :passepartout))
-         (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))
-         (wrapped-cmd (format nil "timeout ~a bash -c ~s" timeout cmd)))
+         (max-sym (find-symbol "*DISPATCHER-SHELL-MAX-OUTPUT*" :passepartout))
+         (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000))))
     (log-message "ACT [Shell]: ~a (timeout: ~as)" cmd timeout)
     (multiple-value-bind (out err code)
-        (uiop:run-program (list "bash" "-c" wrapped-cmd)
+        (uiop:run-program (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd)
                           :output :string :error-output :string
                           :ignore-error-status t)
       (cond

org/system-model-embedding.org

@@ -7,13 +7,16 @@
 
 ~system-model-embedding~ converts text into vector representations for semantic search and memory retrieval. It provides three backends:
 
+- ~:trigram~ — a zero-dependency fallback that uses character-trigram Jaccard similarity. Pure Lisp, works fully offline, captures lexical overlap.
+- ~:sha256~ — integrity-only (explicit opt-in). SHA-256 hashing for environments where even trivial computation is undesirable.
 - ~:local~ — any OpenAI-compatible ~/api/embeddings~ endpoint (Ollama, vLLM, etc.)
 - ~:openai~ — the OpenAI ~/v1/embeddings~ API with an API key
-- ~:hashing~ — a zero-dependency fallback that produces deterministic vectors from SHA-256 hashes. No server, no config, works offline.
 
 The embedding queue (~embed-queue-object~ / ~embed-all-pending~) decouples document indexing from the main loop. On each heartbeat tick, ~embed-all-pending~ drains the queue and embeds all accumulated objects. This prevents indexing traffic from blocking conversational responses.
 
-The default provider is ~:hashing~ — useful for bootstrapping with zero configuration and for deployments where embedding quality isn't critical. Switch to ~:local~ or ~:openai~ when you have an embedding server available.
+The default provider is ~:trigram~ — it captures lexical overlap (character trigram bloom filter → cosine similarity approximates Jaccard) and works immediately with zero configuration. Switch to ~:local~ or ~:openai~ when you have an embedding server; switch to ~:sha256~ for integrity-only deployments.
+
+**Why not SHA-256 by default?** SHA-256 is a cryptographic hash with the avalanche property — one-bit input differences produce entirely different outputs. "implement user login form" and "implement user login forn" (one character difference) have completely different SHA-256 values → cosine similarity near zero. This makes SHA-256 correct for integrity verification (Merkle tree) but useless for similarity-based retrieval. The trigram Jaccard approach captures lexical overlap: "authentication" and "authenticate" share trigrams "aut", "uth", "the", "hen", "ent", "nti", "tic", "ica", producing high cosine similarity (0.80). "authentication" and "banana" share zero trigrams → 0.0 similarity.
 
 This replaces the old ~system-embedding-gateway~ with the same logic but renamed to ~system-model-embedding~ to live alongside the other ~system-model-*~ skills.
 
@@ -23,8 +26,8 @@ This replaces the old ~system-embedding-gateway~ with the same logic but renamed
 #+begin_src lisp
 (in-package :passepartout)
 
-(defvar *embedding-provider* :hashing
-  "Active embedding provider: :hashing, :local, :openai.")
+(defvar *embedding-provider* :trigram
+  "Active embedding provider: :trigram, :sha256, :local, :openai.")
 
 (defvar *embedding-queue* nil
   "Queue of text objects awaiting embedding.")
@@ -75,15 +78,36 @@ This replaces the old ~system-embedding-gateway~ with the same logic but renamed
         (list :error (format nil "OpenAI Embedding failed: ~a" c))))))
 #+end_src
 
-** Hashing fallback
+** Trigram backend (v0.4.0)
 #+begin_src lisp
-(defun embedding-backend-hashing (text)
-  "Fallback: produces a deterministic vector from the text hash."
+(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))
 #+end_src
 
 ** Object embedding and queuing
@@ -97,11 +121,12 @@ This replaces the old ~system-embedding-gateway~ with the same logic but renamed
 
 (defun embed-object (text)
   "Embed a single text string using the active backend."
-  (let* ((selected (or *embedding-backend* *embedding-provider* :hashing))
+  (let* ((selected (or *embedding-backend* *embedding-provider* :trigram))
          (backend (case selected
-                    (:local #'embedding-backend-local)
-                    (:openai #'embedding-backend-openai)
-                    (t #'embedding-backend-hashing))))
+                     (:local #'embedding-backend-local)
+                     (:openai #'embedding-backend-openai)
+                     (:sha256 #'embedding-backend-sha256)
+                     (t #'embedding-backend-trigram))))
     (if backend
         (progn
           (log-message "EMBEDDING: Provider ~a, backend=~a" selected backend)