#+TITLE: Passepartout TUI — Controller
#+PROPERTY: header-args:lisp :tangle ../lisp/channel-tui-main.lisp

* Controller

Event handlers + daemon I/O + main loop.

** v0.8.0 — Minibuffer (cl-tty Dialog Stack)

Replaces ad-hoc palette + wizard overlays with cl-tty's Dialog stack.
Typing =/= as the first character opens a ~select-dialog~ with ~25 slash
commands filtered in real time. Selecting a command dispatches it;
selecting =/wizard= transitions to a ~prompt-dialog~ chain. cl-tty's
~cl-tty.dialog:*dialog-stack*~ handles push/pop; Esc dismisses the top dialog.

~*slash-commands*~ is the single source of truth for available commands.
~open-minibuffer~ pushes the select-dialog. ~minibuffer-handle-key~
converts Croatoan key codes to cl-tty ~key-event~ structs and delegates
to ~select-handle-key~. Printable characters update the Select's filter;
Backspace removes the last filter character; Enter/Up/Down/Esc route
through the select widget's navigation.

The wizard-dialog subclass validates each step and writes config to
~/.passepartout/config.lisp~. Daisy-chaining: wizard provider selection
→ API key entry → save confirmation. Future sub-modes (=/settings=,
=/help=) slot in as additional dialog types pushed onto the same stack.

** Contract

1. (on-key ch): dispatches key presses: Enter triggers send (extracts
   input buffer, pushes history, sends to daemon, clears buffer),
   ~\\ + Enter~ inserts a literal newline (multi-line input),
   Tab completes command names, Backspace deletes, arrows scroll
   chat and history.
   v0.7.0: Ctrl+U clears line, Ctrl+W deletes word, Ctrl+A/E home/end,
   Ctrl+L redraws, Ctrl+D quit on empty, Ctrl+X+E opens $EDITOR.
   v0.8.0: when a dialog is on cl-tty's ~cl-tty.dialog:*dialog-stack*~, keys route
   through ~minibuffer-handle-key~ instead of normal input. Typing =/=
   as the first character opens a ~select-dialog~ with ~*slash-commands*~.
   Non-printable keys are ignored.
2. (on-daemon-msg msg): processes inbound daemon messages. Routes
   text responses to chat display (:agent), handshake to system
   messages, routes errors to log via ~log-message~. Extracts
   ~: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
   Croatoan windows, optionally starts Swank REPL, runs
   render/input event loop at ~30fps. Renders dialog overlays when
   cl-tty's ~cl-tty.dialog:*dialog-stack*~ is non-nil.
5. (on-key-sidebar key): v0.8.0 — handles sidebar-specific
   keybindings: Ctrl+X+B toggles sidebar, Esc dismisses overlay.
6. (*slash-commands*): v0.8.0 — list of ~25 command plists, each
   with ~:name~ (display string), ~:desc~ (tooltip), and ~:action~
   (thunk that dispatches the command). Drives cl-tty's ~Select~ widget.
7. (open-minibuffer): v0.8.0 — pushes a ~select-dialog~ onto cl-tty's
   ~cl-tty.dialog:*dialog-stack*~ with ~*slash-commands*~ as options. Sets the
   select's ~:on-select~ to dispatch the chosen command.
 8. (minibuffer-handle-key ch): v0.8.0 — converts Croatoan key code CH
    to a cl-tty ~key-event~, then routes through the active dialog's
    ~select-handle-key~. Returns T if handled (dialog consumed the key).
 9. (make-wizard-dialog): v0.8.0 — creates a multi-step wizard dialog:
    provider selection → API key entry → save confirmation. Returns a
    ~dialog~ instance pushed onto ~cl-tty.dialog:*dialog-stack*~. Each step validates
    before advancing. Final step writes ~/.passepartout/config.lisp~.
10. (*daemon-commands*): v0.8.0 — list of ~16 daemon command plists,
    organized by category (Session, Memory, System, Help), each with
    ~:title~, ~:value~, ~:desc~, ~:action~, and optional ~:category t~
    for headers. Drives the command palette (~ctrl-tty Select~).
11. (open-command-palette): v0.8.0 — pushes a ~select-dialog~ onto
    ~cl-tty.dialog:*dialog-stack*~ with ~*daemon-commands*~ as options.
    Categories are rendered as dimmed headers; selection dispatches the
    command's ~:action~ thunk. Opens on Ctrl+P.

** Event Handlers
#+begin_src lisp
(in-package :passepartout.channel-tui)

(defun on-key (&rest args)
  ;; Normalize: get-char returns raw ncurses integer codes (e.g. 263 for
  ;; backspace). Croatoan's code-key + key-name convert them to keywords
  ;; so the cond below can use eq.
  (let* ((raw (car args))
         (ch (if (and (integerp raw) (> raw 255))
                 (or (let* ((k (code-key raw))
                            (name (and k (key-name k))))
                       name)
                     ;; Fallback for known ncurses codes when Croatoan
                     ;; key tables aren't available (e.g. in tests)
                     (case raw
                       (343 :enter)
                       (259 :up)
                       (258 :down)
                       (260 :left)
                       (261 :right)
                       (339 :ppage)
                       (338 :npage)
                       (t raw)))
                 raw)))
      (cond
          ;; v0.8.0: minibuffer dialog active — route through cl-tty select
          ((and (boundp 'cl-tty.dialog:*dialog-stack*)
                cl-tty.dialog:*dialog-stack*
                (minibuffer-handle-key ch))
           (setf (st :dirty) (list t t nil)))
          ;; v0.7.1: Esc — interrupt streaming
        ((and (eql ch 27) (st :streaming-text))
         (send-daemon (list :type :event :payload '(:action :cancel-stream)))
         (when (> (length (st :messages)) 0)
           (let ((idx (1- (length (st :messages)))))
             (setf (getf (aref (st :messages) idx) :content)
                   (concatenate 'string
                                (getf (aref (st :messages) idx) :content)
                                " [interrupted]"))
             (setf (getf (aref (st :messages) idx) :streaming) nil)
             (setf (getf (aref (st :messages) idx) :time) (now))))
         (setf (st :streaming-text) nil)
         (setf (st :busy) nil)
         (setf (st :dirty) (list t t nil)))
        ;; v0.7.2: Esc — exit search mode
        ((and (eql ch 27) (st :search-mode))
         (setf (st :search-mode) nil
               (st :search-matches) nil
               (st :search-query) "")
         (setf (st :dirty) (list nil t nil))
         (add-msg :system "Search exited"))
        ;; v0.7.2: search mode — Up/Down navigate matches
        ((and (st :search-mode) (or (eql ch 259) (eq ch :up)))
         (let* ((matches (st :search-matches))
                (idx (st :search-match-idx))
                (new-idx (max 0 (1- idx))))
           (setf (st :search-match-idx) new-idx)
           (when matches
             (setf (st :scroll-offset) (nth new-idx matches))
             (add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches)))
             (setf (st :dirty) (list nil t nil)))))
        ((and (st :search-mode) (or (eql ch 258) (eq ch :down)))
         (let* ((matches (st :search-matches))
                (idx (st :search-match-idx))
                (new-idx (min (1- (length matches)) (1+ idx))))
           (setf (st :search-match-idx) new-idx)
           (when matches
             (setf (st :scroll-offset) (nth new-idx matches))
             (add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches)))
             (setf (st :dirty) (list nil t nil)))))
        ;; v0.7.2: search mode — Enter jumps to current match
        ((and (st :search-mode) (or (eql ch 13) (eql ch 10) (eq ch :enter)))
         (let ((matches (st :search-matches))
               (idx (st :search-match-idx)))
           (when (and matches (>= (length matches) (1+ idx)))
             (setf (st :scroll-offset) (nth idx matches))
             (setf (st :search-mode) nil
                   (st :search-matches) nil
                   (st :search-query) "")
             (add-msg :system (format nil "Jumped to match ~d" (1+ idx)))
             (setf (st :dirty) (list nil t nil)))))
       ;; v0.7.1: Tab on empty input — extract then open URL from agent message
       ((and (or (eql ch 9) (eq ch :tab))
              (null (st :input-buffer)))
        (if (st :url-buffer)
            ;; Already extracted — now open it
            (progn
              (add-msg :system (format nil "Opening ~a" (st :url-buffer)))
              (setf (st :url-buffer) nil))
            ;; Extract URL from last agent message
            (let ((url nil))
              (loop for i from (1- (length (st :messages))) downto 0
                    for msg = (aref (st :messages) i)
                    for content = (getf msg :content)
                    for role = (getf msg :role)
                    while (eq role :agent)
                    when content
                    do (let ((pos (or (search "https://" content) (search "http://" content))))
                         (when pos
                           (let ((end (or (position-if (lambda (c) (find c '(#\Space #\Newline #\Tab #\))))
                                                        content :start pos)
                                          (length content))))
                             (setf url (subseq content pos end))
                             (return)))))
              (if url
                  (progn
                    (setf (st :url-buffer) url)
                    (add-msg :system (format nil "Press Tab to open ~a" url))
                    (setf (st :dirty) (list t t nil)))
                  nil))))
       ;; v0.7.0: Ctrl key bindings
      ((eql ch 21) ; Ctrl+U — clear line
       (setf (st :input-buffer) nil)
       (setf (st :dirty) (list nil nil t)))
      ((eql ch 23) ; Ctrl+W — delete word backward
       (let ((buf (st :input-buffer)))
         (loop while (and buf (char= (first buf) #\Space)) do (pop buf))
         (loop while (and buf (char/= (first buf) #\Space)) do (pop buf))
         (setf (st :input-buffer) buf)
         (setf (st :dirty) (list nil nil t))))
      ((eql ch 1)  ; Ctrl+A — home
       (setf (st :cursor-pos) 0))
      ((eql ch 5)  ; Ctrl+E — end
       (setf (st :cursor-pos) (length (st :input-buffer))))
       ((eql ch 12) ; Ctrl+L — redraw
        (setf (st :dirty) (list t t t)))
       ((eql ch 4)  ; Ctrl+D — quit on empty
        (when (or (null (st :input-buffer)) (string= "" (input-string)))
          (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit.")))
        ((eql ch 6)  ; v0.7.2 Ctrl+F — message search
         (add-msg :system "Use /search <query> to find messages"))
        ((eql ch 28) ; v0.8.0 Ctrl+\ — open setup minibuffer
         (open-minibuffer)
         ;; If minibuffer opens, simulate typing /setup to filter to it
         (when cl-tty.dialog:*dialog-stack*
           (let ((sel (cl-tty.dialog:dialog-content (first cl-tty.dialog:*dialog-stack*))))
             (when (typep sel 'select)
               (setf (cl-tty.select:select-filter sel) "setup"))))
         (setf (st :dirty) (list t t nil)))
        ((eql ch 7)  ; v0.7.2 Ctrl+G — toggle gate collapse
        (let ((gate-idx nil))
          (loop for i from (1- (length (st :messages))) downto 0
                for m = (aref (st :messages) i)
                when (and (getf m :gate-trace) (listp (getf m :gate-trace)))
                do (setf gate-idx i) (loop-finish))
          (if gate-idx
              (let ((cg (st :collapsed-gates)))
                (if (member gate-idx cg)
                    (setf (st :collapsed-gates) (remove gate-idx cg))
                    (push gate-idx (st :collapsed-gates)))
                (add-msg :system (format nil "Gate trace ~a for msg ~a"
                                        (if (member gate-idx (st :collapsed-gates)) "hidden" "shown")
                                        gate-idx))
                (setf (st :dirty) (list nil t nil)))
              (add-msg :system "No gate trace to toggle"))))
       ((eql ch 24) ; Ctrl+X prefix
       (setf (st :pending-ctrl-x) t))
             ((and (st :pending-ctrl-x) (eql ch 2)) ; Ctrl+X+B — toggle sidebar
        (setf (st :pending-ctrl-x) nil)
        (passepartout.channel-tui::sidebar-toggle)
        (add-msg :system (if (st :sidebar-visible) "Sidebar shown (Ctrl+X+B to hide)" "Sidebar hidden")))
        ((eql ch 16) ; v0.8.0 Ctrl+P — open command palette (daemon commands)
         (progn
           (open-command-palette)
           (setf (st :dirty) (list t t nil))))
        ((eql ch 4)  ; Ctrl+D — quit on empty
         (when (or (null (st :input-buffer)) (string= "" (input-string)))
           (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit.")))
        ((eql ch 6)  ; v0.7.2 Ctrl+F — message search
         (add-msg :system "Use /search <query> to find messages"))
        ((eql ch 7)  ; v0.7.2 Ctrl+G — toggle gate trace collapse
         (let ((gate-idx nil))
           (loop for i from (1- (length (st :messages))) downto 0
                 for m = (aref (st :messages) i)
                 when (and (getf m :gate-trace) (listp (getf m :gate-trace)))
                 do (setf gate-idx i) (loop-finish))
           (if gate-idx
               (let ((cg (st :collapsed-gates)))
                 (if (member gate-idx cg)
                     (setf (st :collapsed-gates) (remove gate-idx cg))
                     (push gate-idx (st :collapsed-gates)))
                 (add-msg :system (format nil "Gate trace ~a for msg ~a"
                                         (if (member gate-idx (st :collapsed-gates)) "hidden" "shown")
                                         gate-idx))
                 (setf (st :dirty) (list nil t nil)))
               (add-msg :system "No gate trace to toggle"))))
        ((eql ch 24) ; Ctrl+X prefix
        (setf (st :pending-ctrl-x) t))
      ((and (st :pending-ctrl-x) (eql ch 5)) ; Ctrl+X+E — editor
       (setf (st :pending-ctrl-x) nil)
       (add-msg :system "Opening $EDITOR... save and exit to return.")
       (setf (st :dirty) (list t t nil)))
      ((and (st :pending-ctrl-x) (not (eql ch 5))) ; cancel Ctrl+X
       (setf (st :pending-ctrl-x) nil)
       (on-key ch)
       (return-from on-key nil))
      ;; Enter
      ((or (eq ch :enter) (eql ch 13) (eql ch 10)
           (eql ch #\Newline) (eql ch #\Return))
        ;; Multi-line: if buffer ends with \, strip it and insert newline
        (if (and (st :input-buffer) (eql (first (st :input-buffer)) #\\))
            (progn (pop (st :input-buffer))
                   (push #\Newline (st :input-buffer))
                   (setf (st :dirty) (list nil nil t)))
            (let ((text (string-trim '(#\Space #\Tab) (input-string))))
              (when (> (length text) 0)
                (push text (st :input-history))
                (setf (st :input-hpos) 0)
                (setf (st :scroll-offset) 0)
                (cond
                  ;; v0.7.2: undo/redo
                  ((string-equal text "/undo")
                   (send-daemon (list :type :event :payload (list :sensor :undo)))
                   (add-msg :system "Undo: restoring memory to previous state"))
                  ((string-equal text "/redo")
                   (send-daemon (list :type :event :payload (list :sensor :redo)))
                   (add-msg :system "Redo: restoring memory"))
                  ;; /help command
                  ((and (>= (length text) 9)
                        (string-equal (subseq text 0 9) "/approve "))
                    (let ((token (string-trim '(#\Space) (subseq text 9))))
                      (send-daemon (list :type :event :payload
                                         (list :action :hitl-respond :token token :decision :approved)))
                      (add-msg :system (format nil "✓ Approved: ~a" token))
                      (resolve-hitl-panel :approved)))
                  ((and (>= (length text) 6)
                        (string-equal (subseq text 0 6) "/deny "))
                    (let ((token (string-trim '(#\Space) (subseq text 6))))
                      (send-daemon (list :type :event :payload
                                         (list :action :hitl-respond :token token :decision :denied)))
                      (add-msg :system (format nil "✗ Denied: ~a" token))
                      (resolve-hitl-panel :denied)))
                  ;; /help command
                  ;; /why command — show last gate trace
                  ((string-equal text "/why")
                   (let ((msgs (st :messages))
                         (found nil))
                     (loop for i from (1- (length msgs)) downto 0
                           for m = (aref msgs i)
                           for gt = (getf m :gate-trace)
                           when (and gt (listp gt) (> (length gt) 0))
                           do (setf found t)
                              (dolist (entry gt)
                                (let* ((gate (getf entry :gate))
                                       (result (getf entry :result))
                                       (reason (getf entry :reason))
                                       (msg (format nil "~a ~a~@[ — ~a~]"
                                                    (case result (:passed "[PASS]") (:blocked "[BLOCKED]") (:approval "[HITL]"))
                                                    (or gate "unknown")
                                                    reason)))
                                  (add-msg :system msg)))
                              (loop-finish))
                         (unless found
                           (add-msg :system "No recent gate trace. Run a tool to see gate decisions."))))
                  ;; /identity command — edit and reload identity file
                  ((string-equal text "/identity")
                   (let* ((editor (or (uiop:getenv "EDITOR") "emacs"))
                          (path (merge-pathnames "memex/IDENTITY.org" (user-homedir-pathname))))
                     (add-msg :system (format nil "Opening ~a in ~a..." (namestring path) editor))
                     (uiop:run-program (list editor (namestring path)) :output t :error-output t)
                     (when (fboundp 'load-identity-file)
                       (funcall 'load-identity-file))
                     (add-msg :system "Identity reloaded")))
                  ;; /audit command — Merkle provenance
                  ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/audit "))
                   (if (fboundp 'audit-node)
                       (let* ((node-id (string-trim '(#\Space) (subseq text 7)))
                              (info (funcall 'audit-node node-id)))
                         (if info
                             (add-msg :system (format nil "Node ~a: type=~a scope=~a hash=~a"
                                                     (getf info :id) (getf info :type)
                                                     (getf info :scope)
                                                     (subseq (or (getf info :hash) "(none)") 0 16)))
                             (add-msg :system (format nil "Node ~a not found" node-id))))
                       (add-msg :system "Memory audit not available")))
                  ;; /tags command — tag stack
                  ;; /tags command — tag stack
                  ((string-equal text "/tags")
                   (let ((cats *tag-categories*))
                     (if cats
                         (dolist (entry cats)
                           (add-msg :system (format nil "~a: ~a" (car entry) (cdr entry))))
                         (add-msg :system "No tags configured. Set TAG_CATEGORIES env var."))))
                  ;; /context command — context visibility
                  ((string-equal text "/context")
                   (let* ((msg-count (length (st :messages)))
                          (focus (or (st :foveal-id) "none"))
                          (id-tokens (min 200 (floor (+ 150 (length (or (st :focus-scope) ""))) 4)))
                          (tool-tokens (if (boundp '*cognitive-tool-registry*)
                                           (floor (* (hash-table-count *cognitive-tool-registry*) 40) 4)
                                           50))
                          (log-tokens (min 4000 (floor (* msg-count 60) 4)))
                          (overhead-tokens 200)
                          (total-est (+ id-tokens tool-tokens log-tokens overhead-tokens))
                          (total-limit 8192)
                          (pct-used (floor (* 100 total-est) total-limit)))
                     (add-msg :system (format nil "Context: ~d msgs, focus=~a, ~d/~d tokens (~d%)"
                                             msg-count focus total-est total-limit pct-used))
                     (add-msg :system (format nil "IDENTITY      ~5d tokens" id-tokens))
                     (add-msg :system (format nil "LOGS          ~5d tokens" log-tokens))
                     (add-msg :system (format nil "TOOLS         ~5d tokens" tool-tokens))
                     (add-msg :system (format nil "TIME+CONFIG   ~5d tokens" overhead-tokens))))
                  ;; /context why <id> — debug node
                  ((and (>= (length text) 13) (string-equal (subseq text 0 13) "/context why "))
                   (let ((node-id (string-trim '(#\Space) (subseq text 13))))
                     (if (fboundp 'memory-object-get)
                         (let ((obj (funcall 'memory-object-get node-id)))
                           (if obj
                               (add-msg :system (format nil "Node ~a: type=~a scope=~a version=~a"
                                                       node-id
                                                       (memory-object-type obj)
                                                       (memory-object-scope obj)
                                                       (memory-object-version obj)))
                               (add-msg :system (format nil "Node ~a not found" node-id))))
                         (add-msg :system "Memory not available"))))
                  ;; /context dropped — pruned nodes
                  ((string-equal text "/context dropped")
                   (add-msg :system "Context debugging: dropped nodes view not yet available (v0.8.0)"))
                   ;; /search command — message search
                   ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search "))
                    (let* ((query (string-downcase (string-trim '(#\Space) (subseq text 8))))
                           (msgs (st :messages))
                           (total (length msgs))
                           (matches nil))
                      (loop for i from 0 below total
                            for m = (aref msgs i)
                            for content = (getf m :content)
                            when (search query (string-downcase content))
                            do (push i matches))
                      (setf matches (nreverse matches))
                      ;; Enter search mode
                      (setf (st :search-mode) t
                            (st :search-query) query
                            (st :search-matches) matches
                            (st :search-match-idx) 0)
                      (if matches
                          (add-msg :system (format nil "Search: ~d matches for '~a' (1/~d) — Up/Down nav, Enter jump, Esc exit"
                                                  (length matches) query (length matches)))
                          (add-msg :system (format nil "0 matches for '~a'" query)))))
                  ;; /rewind command — session rewind
                  ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/rewind "))
                   (let* ((n-str (string-trim '(#\Space) (subseq text 8)))
                          (n (handler-case (parse-integer n-str) (error () nil))))
                     (if n
                         (if (fboundp 'rollback-memory)
                             (let* ((idx (1- n))
                                    (snaps *memory-snapshots*)
                                    (ts (when (< idx (length snaps))
                                          (getf (nth idx snaps) :timestamp))))
                               (funcall 'rollback-memory idx)
                               (add-msg :system (format nil "Rewound ~d turn~:p~@[ (~a)~]" n ts)))
                             (add-msg :system "Memory rollback not available"))
                         (add-msg :system "Usage: /rewind <number>"))))
                  ;; /sessions command — list snapshots
                  ((string-equal text "/sessions")
                   (let ((snaps *memory-snapshots*))
                     (if snaps
                         (let ((shown (subseq snaps 0 (min 10 (length snaps)))))
                           (add-msg :system (format nil "~d snapshots (showing ~d):" 
                                                   (length snaps) (length shown)))
                           (loop for s in shown
                                 for i from 0
                                 for ts = (getf s :timestamp)
                                 for data = (getf s :data)
                                 for size = (hash-table-size data)
                                 do (add-msg :system (format nil "  #~d: ~a objects, timestamp ~d"
                                                             (1+ i) size ts))))
                          (add-msg :system "No snapshots available"))))
                  ;; /audit verify — memory integrity
                  ((string-equal text "/audit verify")
                   (let ((count 0) (hashed 0))
                     (maphash (lambda (k v) (declare (ignore k))
                                     (when v
                                       (incf count)
                                       (when (memory-object-hash v)
                                         (incf hashed))))
                              *memory-store*)
                     (add-msg :system (format nil "Audit: ~d objects, ~d hashed, ~d snapshots"
                                             count hashed
                                             (length *memory-snapshots*)))))
                  ;; /resume <n> — resume from snapshot
                  ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/resume "))
                   (let* ((n-str (string-trim '(#\Space) (subseq text 8)))
                          (n (handler-case (parse-integer n-str) (error () nil))))
                     (if n
                         (if (fboundp 'rollback-memory)
                             (progn (funcall 'rollback-memory (1- n))
                                    (add-msg :system (format nil "Resumed from snapshot ~d" n)))
                             (add-msg :system "Memory rollback not available"))
                         (add-msg :system "Usage: /resume <number>"))))
                  ;; /help <topic> — search user manual
                  ((and (>= (length text) 6) (string-equal (subseq text 0 6) "/help "))
                   (let* ((topic (string-trim '(#\Space) (subseq text 6)))
                          (results (self-help-lookup topic)))
                     (dolist (entry results)
                       (add-msg :system (format nil "~a: ~a" (car entry) (cdr entry))))
                     (unless results
                       (add-msg :system (format nil "Topic '~a' not found in USER_MANUAL.org" topic)))))
                   ((string-equal text "/help")
                    (add-msg :system "/undo          Undo last operation")
                    (add-msg :system "/redo          Redo last operation")
                    (add-msg :system "/why           Show last gate trace")
                    (add-msg :system "/identity      Edit IDENTITY.org")
                    (add-msg :system "/tags          List tag severities")
                    (add-msg :system "/audit <id>    Inspect memory object")
                    (add-msg :system "/search <q>    Search messages")
                    (add-msg :system "/context       Show context summary")
                    (add-msg :system "/eval <expr>   Evaluate Lisp")
                    (add-msg :system "/rewind <n>    Rewind to snapshot N")
                   (add-msg :system "/sessions      Show snapshots")
                   (add-msg :system "/resume <n>    Resume from snapshot")
                   (add-msg :system "/focus <proj>  Set project context")
                   (add-msg :system "/theme         Show theme")
                   (add-msg :system "/help [topic]  Show this help")
                   (add-msg :system "\\ + Enter      Multi-line input")
                   (add-msg :system "Ctrl+G         Toggle gate trace"))
                   ;; /setup command — open minibuffer filtered to setup
                    ((string-equal text "/setup")
                     (open-minibuffer)
                     (when cl-tty.dialog:*dialog-stack*
                       (let ((sel (cl-tty.dialog:dialog-content (first cl-tty.dialog:*dialog-stack*))))
                         (when (typep sel 'select)
                           (setf (cl-tty.select:select-filter sel) "setup"))))
                     (setf (st :dirty) (list t t nil)))
                   ;; /theme command
                   ((string-equal text "/theme")
                    (add-msg :system (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)))
                    (add-msg :system "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 "))
                   (handler-case
                       (let* ((*read-eval* t)
                              (*package* (find-package :passepartout.channel-tui))
                              (r (eval (read-from-string (subseq text 6)))))
                         (add-msg :system (format nil "=> ~s" r)))
                     (error (c) (add-msg :system (format nil "=> ✗ ~a" c)))))
                  ;; /focus <project> — set project context
                  ((and (>= (length text) 7)
                        (string-equal (subseq text 0 7) "/focus "))
                   (let ((project (string-trim '(#\Space) (subseq text 7))))
                     (if (and (fboundp 'focus-project) (> (length project) 0))
                         (progn (funcall 'focus-project project nil)
                                (add-msg :system (format nil "Focused on project: ~a" project)))
                         (add-msg :system "Usage: /focus <project-name>"))))
                  ;; /scope <scope> — change context scope
                  ((and (>= (length text) 7)
                        (string-equal (subseq text 0 7) "/scope "))
                   (let ((scope-str (string-trim '(#\Space) (subseq text 7))))
                     (cond
                       ((and (fboundp 'focus-session) (string-equal scope-str "session"))
                        (funcall 'focus-session)
                        (add-msg :system "Scope: session"))
                       ((and (fboundp 'focus-project) (string-equal scope-str "project"))
                        (funcall 'focus-project nil nil)
                        (add-msg :system "Scope: project"))
                       ((and (fboundp 'focus-memex) (string-equal scope-str "memex"))
                        (funcall 'focus-memex)
                        (add-msg :system "Scope: memex"))
                       (t (add-msg :system "Usage: /scope memex|session|project")))))
                  ;; /unfocus — pop context
                  ((and (>= (length text) 8)
                        (string-equal (subseq text 0 8) "/unfocus"))
                   (if (fboundp 'unfocus)
                       (progn (funcall 'unfocus)
                              (add-msg :system "Popped context"))
                       (add-msg :system "Context manager not loaded")))
                   ;; /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 :cursor-pos) 0)
                 (setf (st :dirty) (list t t t))))))
        ;; Tab — command completion (v0.7.0: extended with subcommand + file paths)
        ((or (eql ch 9) (eq ch :tab))
         (let ((text (input-string)))
           (cond
             ;; @ prefix — file path completion
             ((and (>= (length text) 1) (eql (char text 0) #\@))
              (let* ((partial (subseq text 1))
                     (memex (or (uiop:getenv "MEMEX_DIR")
                                (namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
                     (proj (merge-pathnames (make-pathname :directory '(:relative "projects")) memex))
                     (files (handler-case (append (uiop:directory-files proj "**/*.org")
                                                  (uiop:directory-files proj "**/*.lisp"))
                              (error () nil)))
                     (names (mapcar (lambda (f) (subseq (namestring f) (1+ (length (namestring proj))))) files))
                     (match (find-if (lambda (n) (and (>= (length n) (length partial))
                                                       (string-equal n partial :end2 (length partial))))
                                     names)))
                (when match
                  (setf (st :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list)))
                  (setf (st :dirty) (list nil nil t)))))
             ;; /theme subcommand
             ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
              (let* ((partial (string-trim '(#\Space) (subseq text 7)))
                     (names '("dark" "light" "solarized" "gruvbox"))
                     (match (if (string= partial "") (first names)
                                (find partial names :test #'string-equal))))
                (when match
                  (setf (st :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list)))
                  (setf (st :dirty) (list nil nil t)))))
             ;; /focus subcommand
             ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/focus "))
              (let* ((partial (string-trim '(#\Space) (subseq text 7)))
                     (memex (or (uiop:getenv "MEMEX_DIR")
                                (namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
                     (proj (merge-pathnames (make-pathname :directory '(:relative "projects")) memex))
                     (dirs (handler-case (mapcar (lambda (d) (car (last (pathname-directory d))))
                                                  (uiop:subdirectories proj))
                             (error () nil)))
                     (match (if (string= partial "") (first dirs)
                                (find-if (lambda (d) (and (>= (length d) (length partial))
                                                           (string-equal d partial :end2 (length partial))))
                                           dirs))))
                (when match
                  (setf (st :input-buffer) (reverse (coerce (concatenate 'string "/focus " match) 'list)))
                  (setf (st :dirty) (list nil nil t)))))
             ;; Command prefix /
             ((and (> (length text) 1) (eql (char text 0) #\/))
              (let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit"))
                     (match (find text cmds :test
                                  (lambda (in cmd) (and (>= (length cmd) (length in))
                                                         (string-equal cmd in :end1 (length in)))))))
                (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))
        (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))
        (let ((page-size (max 10 (floor (length (st :messages)) 3))))
          (setf (st :scroll-offset) (+ (st :scroll-offset) page-size)))
        (setf (st :dirty) (list nil t nil)))
       ;; PageDown
       ((or (eq ch :npage) (eql ch 338))
        (let ((page-size (max 10 (floor (length (st :messages)) 3))))
          (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) page-size))))
        (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))))))))


;; v0.8.0 — Minibuffer: *slash-commands*, open-minibuffer, minibuffer-handle-key, make-wizard-dialog

(defvar *slash-commands*
  (list (list :name "/focus" :desc "Set project context"
              :action (lambda () (add-msg :system "/focus")))
        (list :name "/scope" :desc "Change context scope"
              :action (lambda () (add-msg :system "/scope memex|session|project")))
        (list :name "/unfocus" :desc "Pop context stack"
              :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus)))))
        (list :name "/search" :desc "Search messages"
              :action (lambda () (add-msg :system "Use /search <query>")))
        (list :name "/why" :desc "Show last gate trace"
              :action (lambda () (add-msg :system "Gate trace: use /why")))
        (list :name "/audit" :desc "Inspect memory object"
              :action (lambda () (add-msg :system "/audit <node-id>")))
        (list :name "/context" :desc "Show context budget"
              :action (lambda () (add-msg :system "/context")))
        (list :name "/theme" :desc "Switch color theme"
              :action (lambda () (add-msg :system "Presets: dark light solarized gruvbox")))
        (list :name "/sidebar" :desc "Toggle sidebar"
              :action #'sidebar-toggle)
        (list :name "/help" :desc "Show all commands"
              :action (lambda () (add-msg :system "Commands: /focus /scope /search /theme /eval /setup /quit ...")))
        (list :name "/setup" :desc "Run setup wizard"
              :action (lambda () (make-wizard-dialog)))
        (list :name "/eval" :desc "Evaluate Lisp expression"
              :action (lambda () (add-msg :system "/eval <expr>")))
        (list :name "/reconnect" :desc "Reconnect to daemon"
              :action (lambda () (disconnect-daemon) (connect-daemon)))
        (list :name "/quit" :desc "Save history and exit"
              :action (lambda () (add-msg :system "* Goodbye *")
                               (send-daemon (list :type :event :payload '(:action :quit)))
                               (setf (st :running) nil))))
    "~25 slash commands driving cl-tty's Select widget in the minibuffer.")

(defun open-minibuffer ()
  "Push a cl-tty.dialog:select-dialog with *slash-commands* onto cl-tty's dialog stack."
  (cl-tty.dialog:push-dialog
   (cl-tty.dialog:select-dialog
    "Commands"
    (loop for cmd in *slash-commands*
          collect (list :title (getf cmd :name)
                        :value cmd
                        :desc (getf cmd :desc)))
    :on-select (lambda (opt)
                 (let ((cmd (getf opt :value))
                       (action (when cmd (getf cmd :action))))
                    (when action (funcall action)))))))

(defvar *daemon-commands*
  (list
   ;; Category: Session
   (list :title "── Session ──" :category t)
   (list :title "Focus Project" :value :focus :desc "Set project context"
         :action (lambda () (add-msg :system "Usage: /focus <project>")))
   (list :title "Change Scope" :value :scope :desc "Switch scope: memex|session|project"
         :action (lambda () (add-msg :system "Usage: /scope memex|session|project")))
   (list :title "Unfocus" :value :unfocus :desc "Pop context stack"
         :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus)))))
   (list :title "Show Context" :value :context :desc "Show context budget summary"
         :action (lambda () (add-msg :system "Use /context for budget or /context why <id> for node details")))
   ;; Category: Memory
   (list :title "── Memory ──" :category t)
   (list :title "List Sessions" :value :sessions :desc "List memory snapshots"
         :action (lambda () (add-msg :system "Use /sessions to list snapshots")))
   (list :title "Rewind" :value :rewind :desc "Rewind to snapshot"
         :action (lambda () (add-msg :system "Usage: /rewind <number>")))
   (list :title "Audit Node" :value :audit :desc "Inspect memory object"
         :action (lambda () (add-msg :system "Usage: /audit <node-id>")))
   ;; Category: System
   (list :title "── System ──" :category t)
   (list :title "Reconnect" :value :reconnect :desc "Reconnect to daemon"
         :action (lambda () (disconnect-daemon) (connect-daemon)))
   (list :title "Quit" :value :quit :desc "Save history and exit"
         :action (lambda () (add-msg :system "* Goodbye *")
                        (send-daemon (list :type :event :payload '(:action :quit)))
                        (setf (st :running) nil)))
   ;; Category: Help
   (list :title "── Help ──" :category t)
   (list :title "Show Help" :value :help :desc "Show all commands"
         :action (lambda () (add-msg :system "Commands: /focus /scope /search /theme /eval /setup /quit ...")))
   (list :title "Why" :value :why :desc "Show last gate trace"
         :action (lambda () (add-msg :system "Use /why to see last gate trace")))
   (list :title "Identity" :value :identity :desc "Edit IDENTITY.org"
         :action (lambda () (add-msg :system "Use /identity to edit")))
   (list :title "Tags" :value :tags :desc "List tag severities"
         :action (lambda () (add-msg :system "Use /tags to list tag severities"))))
  "Daemon commands for the command palette (Ctrl+P), organized by category.")

(defun open-command-palette ()
  "Push a select-dialog with *daemon-commands* onto cl-tty's dialog stack.
   Ctrl+P opens this palette. Categories: Session, Memory, System, Help."
  (cl-tty.dialog:push-dialog
   (cl-tty.dialog:select-dialog
    "Command Palette"
    (loop for cmd in *daemon-commands*
          collect (list :title (getf cmd :title)
                        :value cmd
                        :desc (getf cmd :desc)
                        :category (getf cmd :category)))
    :on-select (lambda (opt)
                 (let ((cmd (getf opt :value))
                       (action (when cmd (getf cmd :action))))
                   (when action (funcall action)))))))

(defun croatoan-to-tty-event (ch)
  "Convert a Croatoan key code to a cl-tty key-event struct."
  (typecase ch
    (keyword
     (case ch
       (:up (cl-tty.input:make-key-event :key :up))
       (:down (cl-tty.input:make-key-event :key :down))
       (:enter (cl-tty.input:make-key-event :key :enter))
       (:escape (cl-tty.input:make-key-event :key :escape))
       (:backspace (cl-tty.input:make-key-event :key :backspace))
       (:ppage (cl-tty.input:make-key-event :key :page-up))
       (:npage (cl-tty.input:make-key-event :key :page-down))
       (t (cl-tty.input:make-key-event :key ch))))
    (integer
     (cond
       ((= ch 27) (cl-tty.input:make-key-event :key :escape))
       ((or (= ch 13) (= ch 10)) (cl-tty.input:make-key-event :key :enter))
       ((or (= ch 263) (= ch 127) (= ch 8)) (cl-tty.input:make-key-event :key :backspace))
       ((= ch 259) (cl-tty.input:make-key-event :key :up))
       ((= ch 258) (cl-tty.input:make-key-event :key :down))
       ((= ch 260) (cl-tty.input:make-key-event :key :left))
       ((= ch 261) (cl-tty.input:make-key-event :key :right))
       ((= ch 339) (cl-tty.input:make-key-event :key :page-up))
       ((= ch 338) (cl-tty.input:make-key-event :key :page-down))
       ((<= 1 ch 26) (cl-tty.input:make-key-event
                       :key (intern (string (code-char (+ #x60 ch))) :keyword)
                       :ctrl t))
       ((<= 32 ch 126) (cl-tty.input:make-key-event
                         :key (intern (string (char-upcase (code-char ch))) :keyword)))
       (t (cl-tty.input:make-key-event :key :unknown :code ch))))
    (t nil)))

(defun minibuffer-handle-key (ch)
  "Route Croatoan key through the active dialog's select widget.
   Printable chars update the filter; special keys route through cl-tty.select:select-handle-key.
   Returns T if the dialog consumed the key."
  (let ((stack cl-tty.dialog:*dialog-stack*))
    (unless stack (return-from minibuffer-handle-key nil))
    (let* ((dialog (first stack))
           (content (cl-tty.dialog:dialog-content dialog)))
      (unless (typep content 'cl-tty.select:select)
        (return-from minibuffer-handle-key nil))
      ;; Backspace: pop last filter char (if any) or pop dialog when empty
      (when (or (eql ch :backspace) (eql ch 263) (eql ch 127) (eql ch 8))
        (let ((f (cl-tty.select:select-filter content)))
          (if (and f (> (length f) 0))
              (progn (setf (cl-tty.select:select-filter content) (subseq f 0 (1- (length f))))
                     (cl-tty.select::select-clamp-index content)
                     t)
              (progn (cl-tty.dialog:pop-dialog) t))))
      ;; Escape: pop the dialog
      (when (or (eql ch 27) (eq ch :escape))
        (cl-tty.dialog:pop-dialog)
        t)
      ;; Printable: append to filter if dialog is a select
      (when (and (integerp ch) (<= 32 ch 126))
        (let* ((c (code-char ch))
               (f (or (cl-tty.select:select-filter content) "")))
          (setf (cl-tty.select:select-filter content)
                (concatenate 'string f (string c)))
          (cl-tty.select::select-clamp-index content)
          t))
      ;; Route through cl-tty.select:select-handle-key for navigation/selection
      (let ((ev (croatoan-to-tty-event ch)))
        (when ev
          (handler-case
              (cl-tty.select:select-handle-key content ev)
            (error () nil)))))))

(defun make-wizard-dialog ()
  "Create a setup wizard dialog daisy-chain: provider select → API key → save.
   Validates at each step; final step writes ~/.passepartout/config.lisp."
  (let* ((state (list :provider nil :api-key nil :memory "1000" :step 0))
         (step-labels '("Provider" "API Key" "Memory" "Review & Save"))
         (step-fns
           (list
            ;; Step 0: provider selection
            (lambda (input)
              (let ((p (string-downcase (string-trim '(#\Space) input))))
                (if (member p '("openai" "anthropic" "ollama" "openrouter" "deepseek" "groq") :test #'string=)
                    (progn (setf (getf state :provider) p) nil)
                    (format nil "Unknown provider: ~a" input))))
            ;; Step 1: API key
            (lambda (input)
              (let ((k (string-trim '(#\Space) input)))
                (if (> (length k) 4)
                    (progn (setf (getf state :api-key) k) nil)
                    "Key too short")))
            ;; Step 2: memory limit
            (lambda (input)
              (let ((v (string-trim '(#\Space) input)))
                (if (or (string= v "") (string= v "1000"))
                    nil
                    (if (every #'digit-char-p v)
                        (progn (setf (getf state :memory) v) nil)
                        "Enter a number"))))
            ;; Step 3: save
            (lambda (input)
              (let ((v (string-downcase (string-trim '(#\Space) input))))
                (cond ((string= v "yes")
                       (let ((env-path (merge-pathnames ".passepartout/config.lisp"
                                                         (user-homedir-pathname))))
                         (handler-case
                             (progn
                               (uiop:ensure-all-directories-exist (list env-path))
                               (with-open-file (out env-path :direction :output
                                                    :if-exists :supersede
                                                    :if-does-not-exist :create)
                                 (format out ";; Passepartout configuration~%")
                                 (format out "(setf *provider* ~s)~%" (getf state :provider))
                                 (format out "(setf *api-key* ~s)~%" (getf state :api-key))
                                 (format out "(setf *memory-max-entries* ~s)~%" (getf state :memory))))
                           (error (c) (format nil "Write failed: ~a" c))))
                       nil)
                      ((string= v "no") nil)
                      (t "Type 'yes' or 'no'")))))))
    (labels ((advance ()
               (let* ((step (getf state :step))
                      (fn (nth step step-fns))
                      (err (funcall fn "ignored")))
                 (declare (ignore fn))
                 ;; Push next prompt dialog or finish
                 (if (< step (1- (length step-labels)))
                     (progn
                       (setf (getf state :step) (1+ step))
                       (cl-tty.dialog:push-dialog
                        (cl-tty.dialog:prompt-dialog
                         (format nil "~a — ~a" (nth (getf state :step) step-labels)
                                 (getf state :provider))
                         :on-submit (lambda (val)
                                      (let ((validation (funcall (nth (getf state :step) step-fns) val)))
                                        (if validation
                                            (progn
 (cl-tty.dialog:push-dialog
                                               (cl-tty.dialog:alert-dialog "Error" validation))
                                              (setf (getf state :step) (1- step)))
                                            (advance)))))))
                     (add-msg :system (format nil "Configuration saved (~a). Run /reconnect."
                                              (getf state :provider)))))))
      ;; Push the first prompt dialog
      (cl-tty.dialog:push-dialog
       (cl-tty.dialog:prompt-dialog
        "Setup — LLM Provider"
        :on-submit (lambda (val)
                     (let ((err (funcall (first step-fns) val)))
                       (if err
                           (cl-tty.dialog:push-dialog
                            (cl-tty.dialog:alert-dialog "Invalid" err))
                           (advance)))))))))

(defun resolve-hitl-panel (decision)
  "Mark the most recent HITL panel message as resolved with DECISION."
  (loop for i from (1- (length (st :messages))) downto 0
        for m = (aref (st :messages) i)
        when (and (getf m :panel) (not (getf m :panel-resolved)))
        do (setf (getf m :panel-resolved) decision)
           (setf (aref (st :messages) i) m)
           (setf (st :dirty) (list nil t nil))
           (loop-finish)))

(defun on-daemon-msg (msg)
  (let* ((payload (getf msg :payload))
         (text (getf payload :text))
         (msg-type (getf msg :type))
         (action (getf payload :action))
         (level (getf msg :level))
         (sensor (getf payload :sensor))
         (gate-trace (getf msg :gate-trace))
         (rule-count (getf payload :rule-count))
         (foveal-id (getf payload :foveal-id)))
    ;; v0.7.2: HITL approval-required panel
    (when (eq level :approval-required)
      (let* ((hitl-msg (or (getf payload :message)
                           (getf payload :text)
                           "HITL approval required"))
             (hitl-action (getf (getf payload :action) :payload))
             (tool-name (getf hitl-action :tool))
             (explanation (or tool-name "unknown action")))
        (add-msg :system (format nil "┌─ Permission Required ─┐~%~a~%Action: ~a~%Respond: /approve HITL-xxxx or /deny HITL-xxxx"
                                hitl-msg explanation)
                 :panel t))
      (setf (st :dirty) (list nil t nil))
      (return-from on-daemon-msg nil))
    ;; v0.7.1: streaming chunk
    (when (eq msg-type :stream-chunk)
      (cond
        ((string= text "")
         ;; Final chunk: stamp time, clear streaming
         (when (> (length (st :messages)) 0)
           (let ((idx (1- (length (st :messages)))))
             (setf (getf (aref (st :messages) idx) :streaming) nil)
             (setf (getf (aref (st :messages) idx) :time) (now))))
         (setf (st :streaming-text) nil)
         (setf (st :busy) nil)
         (setf (st :dirty) (list nil t nil))
         (return-from on-daemon-msg nil))
        ((null (st :streaming-text))
         ;; First chunk: add new streaming message
         (setf (st :streaming-text) "")
         (setf (st :busy) nil)
         (add-msg :agent text)
         (let ((idx (1- (length (st :messages)))))
           (setf (getf (aref (st :messages) idx) :streaming) t))
         (setf (st :streaming-text) text)
         (setf (st :dirty) (list nil t nil))
         (return-from on-daemon-msg nil))
        (t
         ;; Subsequent chunk: append
         (let* ((new-text (concatenate 'string (st :streaming-text) text))
                (idx (1- (length (st :messages)))))
           (setf (st :streaming-text) new-text)
           (setf (getf (aref (st :messages) idx) :content) new-text)
           (setf (st :dirty) (list nil t nil)))
         (return-from on-daemon-msg nil))))
    (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 :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))))))

#+end_src

#+begin_src lisp
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
(defun resolve-hitl-panel (decision)
  "Mark the most recent HITL panel message as resolved with DECISION."
  (loop for i from (1- (length (st :messages))) downto 0
        for m = (aref (st :messages) i)
        when (and (getf m :panel) (not (getf m :panel-resolved)))
        do (setf (getf m :panel-resolved) decision)
           (setf (aref (st :messages) i) m)
           (setf (st :dirty) (list nil t nil))
           (loop-finish)))

;; v0.7.2 — self-help-lookup: read USER_MANUAL.org and find matching sections
(defun self-help-lookup (topic)
  "Search USER_MANUAL.org for headlines matching TOPIC, return content previews."
  (let* ((manual-path (merge-pathnames "projects/passepartout/docs/USER_MANUAL.org"
                                       (merge-pathnames "memex/" (user-homedir-pathname))))
         (results nil))
    (handler-case
        (let* ((text (uiop:read-file-string manual-path))
               (lines (uiop:split-string text :separator '(#\Newline)))
               (in-section nil)
               (section-content nil))
          (dolist (line lines)
            (let ((trimmed (string-trim '(#\Space #\Tab) line)))
              (cond
                ;; New headline
                ((and (>= (length trimmed) 2) (eql (char trimmed 0) #\*))
                 ;; Flush previous section if in one
                 (when (and in-section section-content)
                   (push (cons in-section (string-trim '(#\Space #\Newline)
                                                       (format nil "~{~a~^ ~}" (reverse section-content))))
                         results))
                 ;; Check if this headline matches topic
                 (let ((title (string-trim '(#\Space #\*) trimmed)))
                   (if (search topic title :test #'char-equal)
                       (setf in-section title
                             section-content nil)
                       (setf in-section nil
                             section-content nil))))
                ;; Content line in matching section
                (in-section
                 (when (and (> (length trimmed) 0)
                            (not (eql (char trimmed 0) #\#)))
                   (push trimmed section-content))))))
          ;; Flush last section
          (when (and in-section section-content)
            (push (cons in-section (string-trim '(#\Space #\Newline)
                                                (format nil "~{~a~^ ~}" (reverse section-content))))
                  results))
          (nreverse results))
      (error (c) (list (cons "Error" (format nil "Cannot read manual: ~a" c)))))))

(defun on-daemon-msg (msg)
  (let* ((payload (getf msg :payload))
         (text (getf payload :text))
         (msg-type (getf msg :type))
         (action (getf payload :action))
         (level (getf msg :level))
         (sensor (getf payload :sensor))
         (gate-trace (getf msg :gate-trace))
         (rule-count (getf payload :rule-count))
         (foveal-id (getf payload :foveal-id)))
    ;; v0.7.2: HITL approval-required panel
    (when (eq level :approval-required)
      (let* ((hitl-msg (or (getf payload :message)
                           (getf payload :text)
                           "HITL approval required"))
             (hitl-action (getf (getf payload :action) :payload))
             (tool-name (getf hitl-action :tool))
             (explanation (or tool-name "unknown action")))
        (add-msg :system (format nil "┌─ Permission Required ─┐~%~a~%Action: ~a~%Respond: /approve HITL-xxxx or /deny HITL-xxxx"
                                hitl-msg explanation)
                 :panel t))
      (setf (st :dirty) (list nil t nil))
      (return-from on-daemon-msg nil))
    ;; v0.7.1: streaming chunk
    (when (eq msg-type :stream-chunk)
      (cond
        ((string= text "")
         ;; Final chunk: stamp time, clear streaming
         (when (> (length (st :messages)) 0)
           (let ((idx (1- (length (st :messages)))))
             (setf (getf (aref (st :messages) idx) :streaming) nil)
             (setf (getf (aref (st :messages) idx) :time) (now))))
         (setf (st :streaming-text) nil)
         (setf (st :busy) nil)
         (setf (st :dirty) (list nil t nil))
         (return-from on-daemon-msg nil))
        ((null (st :streaming-text))
         ;; First chunk: add new streaming message
         (setf (st :streaming-text) "")
         (setf (st :busy) nil)
         (add-msg :agent text)
         (let ((idx (1- (length (st :messages)))))
           (setf (getf (aref (st :messages) idx) :streaming) t))
         (setf (st :streaming-text) text)
         (setf (st :dirty) (list nil t nil))
         (return-from on-daemon-msg nil))
        (t
         ;; Subsequent chunk: append
         (let* ((new-text (concatenate 'string (st :streaming-text) text))
                (idx (1- (length (st :messages)))))
           (setf (st :streaming-text) new-text)
           (setf (getf (aref (st :messages) idx) :content) new-text)
           (setf (st :dirty) (list nil t nil)))
         (return-from on-daemon-msg nil))))
(when rule-count (setf (st :rule-count) rule-count))
     (when foveal-id (setf (st :foveal-id) foveal-id))
     ;; v0.8.0: sidebar enrichment fields
     (when (getf payload :block-counts) (setf (st :block-counts) (getf payload :block-counts)))
     (when (getf payload :context-usage) (setf (st :context-usage) (getf payload :context-usage)))
     (when (getf payload :modified-files) (setf (st :modified-files) (getf payload :modified-files)))
     (when (getf payload :session-cost) (setf (st :session-cost) (getf payload :session-cost)))
    (cond
      (text (setf (st :busy) nil)
            (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))))))
#+end_src

** Daemon Communication
#+begin_src lisp
(defun send-daemon (msg)
  (let ((s (st :stream)))
    (when (and s (open-stream-p s))
      (handler-case
          (progn
            (format s "~a" (frame-message msg))
            (finish-output s))
        (error () nil)))))

(defun recv-daemon (s)
  (handler-case
      (let* ((hdr (make-string 6)) (n 0))
        (loop while (< n 6)
              do (let ((ch (read-char s nil)))
                    (unless ch (return-from recv-daemon nil))
                    (setf (char hdr n) ch) (incf n)))
        (let* ((len (parse-integer hdr :radix 16 :junk-allowed t))
               (buf (make-string (or len 0))))
          (when (and len (> len 0))
            (loop for i from 0 below len
                  do (let ((ch (read-char s nil)))
                        (unless ch (return-from recv-daemon nil))
                        (setf (char buf i) ch)))
            (let ((*read-eval* nil))
              (read-from-string buf)))))
    (error () nil)))

(defun reader-loop (s)
  (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
#+begin_src lisp
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
  (add-msg :system "* Connecting to daemon... *")
  (loop for attempt from 1 to 3
        for backoff = 0 then 3
        do (sleep backoff)
           (handler-case
               (let ((s (usocket:socket-connect host port :timeout 5)))
                 (setf (st :stream) (usocket:socket-stream s)
                       (st :connected) t)
                 (bt:make-thread (lambda () (reader-loop (st :stream)))
                                :name "tui-reader")
                 (add-msg :system (format nil "* Connected v~a *" "0.5.0"))
                 (return-from connect-daemon t))
             (usocket:connection-refused-error (c)
               (when (= attempt 3)
                 (add-msg :system (format nil "* No daemon on port ~a after ~a attempts *"
                                         port attempt))))
             (error (c)
               (add-msg :system (format nil "* Connection attempt ~a failed: ~a *"
                                        attempt c))
               (when (= attempt 3)
                 (add-msg :system "* TIP: run 'passepartout daemon' first *")))))
  nil)

(defun disconnect-daemon ()
  (when (st :stream)
    (ignore-errors (close (st :stream)))
    (setf (st :stream) nil (st :connected) nil)
    (add-msg :system "* Disconnected *")))
#+end_src

** Main Loop
#+begin_src lisp
(defun tui-run-screen (scr)
  "The full TUI event loop. Called from tui-main inside with-screen."
  (let* ((h (or (height scr) 24))
         (w (or (width scr) 80))
         (sidebar-w (when (>= w 120)
                       (make-instance 'window :height (- h 5) :width 42 :y 3 :x (- w 44))))
         (content-w (if sidebar-w (- w 44) (- w 2)))
         (ch (- h 5))
         (sw (make-instance 'window :height 3 :width content-w :y 0 :x 1))
         (cw (make-instance 'window :height ch :width content-w :y 3 :x 1))
         (iw (make-instance 'window :height 1 :width content-w :y (- h 1) :x 1))
         (swank-port (or (ignore-errors
                          (parse-integer (uiop:getenv "TUI_SWANK_PORT")))
                         4006)))
       (setf (function-keys-enabled-p iw) t
             (input-blocking iw) nil
             (st :dirty) (list t t t)
             (st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw)
       (connect-daemon)
       (when (> swank-port 0)
         (handler-case
             (progn
               (ql:quickload :swank :silent t)
               (funcall (find-symbol "CREATE-SERVER" "SWANK")
                        :port swank-port :dont-close t)
               (add-msg :system
                        (format nil "* Swank ~d  M-x slime-connect *" swank-port)))
           (error ()
             (add-msg :system "* Swank unavailable *"))))
       (flet ((recreate-windows (scr-width scr-height)
                (let* ((new-w scr-width)
                       (new-h scr-height)
                       (has-sidebar (and (>= new-w 120) (st :sidebar-visible)))
                       (new-sidebar-w (when has-sidebar
                                        (make-instance 'window :height (- new-h 5)
                                                              :width 42 :y 3 :x (- new-w 44))))
                       (new-content-w (if new-sidebar-w (- new-w 44) (- new-w 2)))
                       (new-ch (- new-h 5)))
                  (setq sw (make-instance 'window :height 3 :width new-content-w :y 0 :x 1)
                        ch new-ch
                        cw (make-instance 'window :height new-ch :width new-content-w :y 3 :x 1)
                        iw (make-instance 'window :height 1 :width new-content-w :y (- new-h 1) :x 1)
                        sidebar-w new-sidebar-w
                        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))))
         (let ((initial-sidebar (and (>= w 120) (st :sidebar-visible))))
           (when initial-sidebar
             (view-sidebar (or sidebar-w
                              (make-instance 'window :height (- h 5) :width 42
                                                    :y 3 :x (- w 44))))
             (refresh (or sidebar-w
                         (make-instance 'window :height (- h 5) :width 42
                                               :y 3 :x (- w 44))))))
        (redraw sw cw ch iw)
        (when sidebar-w
          (view-sidebar sidebar-w)
          (refresh sidebar-w))
        ;; v0.8.0: render cl-tty dialog overlay when stack is non-empty
        (when (and (boundp 'cl-tty.dialog:*dialog-stack*)
                   cl-tty.dialog:*dialog-stack*)
          (render-dialog-overlay scr w h))
         (refresh scr)
         (loop while (st :running) do
          (dolist (ev (drain-queue))
            (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)))
            (cond
              ((or (not ch) (equal ch -1)) nil)
              ((eql ch 410)
               (recreate-windows (or (width scr) 80) (or (height scr) 24))
               (redraw sw cw ch iw)
               (refresh scr))
              (t (ignore-errors (on-key ch)))))
          (redraw sw cw ch iw)
          (when sidebar-w
            (view-sidebar sidebar-w)
            (refresh sidebar-w))
          ;; Recreate windows when sidebar visibility or terminal width changes
          (let ((sidebar-wanted (and (st :sidebar-visible) (>= w 120))))
            (when (or (and sidebar-wanted (not sidebar-w))
                      (and (not sidebar-wanted) sidebar-w))
              (recreate-windows w h)
              (redraw sw cw ch iw)))
          ;; v0.8.0: render cl-tty dialog overlay
          (when (and (boundp 'cl-tty.dialog:*dialog-stack*)
                     cl-tty.dialog:*dialog-stack*)
            (render-dialog-overlay scr w h))
          (refresh scr)
          (sleep 0.03))
          (disconnect-daemon))))

(defun render-dialog-overlay (scr w h)
  "Render the top cl-tty dialog as a Croatoan overlay.
   Draws a dimmed backdrop then a centered bordered panel with select options."
  (let* ((dialog (first cl-tty.dialog:*dialog-stack*))
         (title (cl-tty.dialog:dialog-title dialog))
         (content (cl-tty.dialog:dialog-content dialog))
         (ww (min 60 (- w 4)))
         (wh (min 18 (- h 4)))
         (wx (floor (- w ww) 2))
         (wy (floor (- h wh) 2)))
    ;; Dimmed backdrop
    (dotimes (row h)
      (add-string scr (make-string w :initial-element #\Space)
                  :y row :x 0 :fgcolor (theme-color :dim) :bgcolor (theme-color :background)))
    ;; Dialog panel window
    (let ((win (make-instance 'window :height wh :width ww :y wy :x wx)))
      (setf (color-pair win) (list (theme-color :border) (theme-color :background)))
      (box win 0 0)
      (add-string win (format nil " ~a " title) :y 0 :x 2 :fgcolor (theme-color :accent))
      ;; Render select widget options
      (when (typep content 'cl-tty.select:select)
        (let* ((filtered (cl-tty.select:select-filtered-options content))
               (sel-idx (cl-tty.select:select-selected-index content))
               (filter-str (cl-tty.select:select-filter content))
               (y 1))
          ;; Show filter line
          (add-string win (format nil " > ~a_" (or filter-str ""))
                      :y y :x 2 :n (- ww 4) :fgcolor (theme-color :input))
          (incf y)
          ;; Show filtered options
          (dolist (item filtered)
            (when (< y (1- wh))
              (let* ((display-idx (first item))
                     (option (third item))
                     (title-str (getf option :title))
                     (desc (getf option :desc))
                     (is-selected (= display-idx sel-idx))
                     (fg (if is-selected (theme-color :highlight) (theme-color :agent))))
                (when is-selected
                  (setf (color-pair win) (list (theme-color :highlight) (theme-color :dim)))
                  (add-string win (make-string (- ww 2) :initial-element #\Space)
                              :y y :x 1 :n (- ww 2))
                  (setf (color-pair win) (list (theme-color :border) (theme-color :background))))
                (add-string win (format nil "~a ~a" (if is-selected ">" " ") title-str)
                            :y y :x 2 :n (min 25 (- ww 4)) :fgcolor fg)
                (when (and desc (not is-selected))
                  (add-string win (format nil " ~a" desc) :y y :x 28 :n (- ww 30)
                              :fgcolor (theme-color :dim)))
                (incf y))))
          ;; Footer hint
          (add-string win (format nil " ~a/~a  |  ↑↓ Navigate  Enter Execute  Esc Close"
                                  (1+ sel-idx) (length filtered))
                      :y (1- wh) :x 1 :n (- ww 2) :fgcolor (theme-color :dim))))
      (refresh win)
      (close win))))

(defun tui-main ()
  (init-state)
  (load-history)
  (theme-load)
  (with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
    (tui-run-screen scr)))

#+end_src

* Test Suite
#+begin_src lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :fiveam :silent t))

(defpackage :passepartout-tui-tests
  (:use :cl :passepartout :passepartout.channel-tui)
  (:export #:tui-suite))

(in-package :passepartout-tui-tests)

(fiveam:def-suite tui-suite :description "Verification of the TUI model and event handling")
(fiveam:in-suite tui-suite)

(fiveam:test test-init-state
  "Contract model.1: init-state returns fresh state plist with required keys."
  (init-state)
  (fiveam:is (eq t (st :running)))
  (fiveam:is (eq :chat (st :mode)))
  (fiveam:is (eq nil (st :connected)))
  (fiveam:is (eq nil (st :stream)))
  (fiveam:is (zerop (length (st :messages))))
  (fiveam:is (eq 0 (st :scroll-offset)))
  (fiveam:is (eq nil (st :busy))))

(fiveam:test test-add-msg
  "Contract model.2: add-msg appends a message with role, content, and time."
  (init-state)
  (add-msg :user "hello")
  (let* ((msgs (st :messages))
         (msg (aref msgs 0)))
    (fiveam:is (eq :user (getf msg :role)))
    (fiveam:is (string= "hello" (getf msg :content)))
    (fiveam:is (stringp (getf msg :time)))
    (fiveam:is (= 5 (length (getf msg :time))))))

(fiveam:test test-add-msg-dirty-flag
  "Contract model.2: add-msg sets dirty flags for status and chat."
  (init-state)
  (setf (st :dirty) (list nil nil nil))
  (add-msg :system "boot")
  (let ((dirty (st :dirty)))
    (fiveam:is (eq t (first dirty)))
    (fiveam:is (eq t (second dirty)))
    (fiveam:is (eq nil (third dirty)))))

(fiveam:test test-queue-event-roundtrip
  "Contract model.3: queue-event + drain-queue preserves events in order."
  (init-state)
  (queue-event '(:type :key :payload (:ch 13)))
  (queue-event '(:type :daemon :payload (:text "hi")))
  (let ((evs (drain-queue)))
    (fiveam:is (= 2 (length evs)))
    (fiveam:is (equal '(:type :key :payload (:ch 13)) (first evs)))
    (fiveam:is (equal '(:type :daemon :payload (:text "hi")) (second evs)))
    (fiveam:is (null (drain-queue)))))

(fiveam:test test-on-key-enter-sends-user-message
  "Contract 1: on-key with Enter extracts input, adds user message, clears buffer."
  (init-state)
  ;; Simulate typing "test"
  (dolist (ch '(#\t #\e #\s #\t))
    (on-key (char-code ch)))
  (fiveam:is (string= "test" (input-string)))
  ;; Simulate Enter key — ncurses returns 343 (KEY_ENTER) when keypad is enabled
  (on-key 343)
  ;; Input buffer should be cleared
  (fiveam:is (string= "" (input-string)))
  ;; A user message should be in the message list
  (let ((msgs (st :messages)))
    (fiveam:is (>= (length msgs) 1))
    (let ((last (aref msgs 0)))
      (fiveam:is (eq :user (getf last :role)))
      (fiveam:is (string= "test" (getf last :content))))))

(fiveam:test test-on-key-eval-command
  "Contract 1: on-key handles /eval command and displays result."
  (init-state)
  ;; Type "/eval (+ 1 2)"
  (dolist (ch (coerce "/eval (+ 1 2)" 'list))
    (on-key (char-code ch)))
  (on-key 343)
  (let ((msgs (st :messages)))
    (fiveam:is (>= (length msgs) 1))
    (let ((last-msg (aref msgs 0)))
      (fiveam:is (eq :system (getf last-msg :role)))
      (fiveam:is (search "=> 3" (getf last-msg :content))))))

(fiveam:test test-on-key-backspace
  "Contract 1: on-key with Backspace removes last character from buffer."
  (init-state)
  (dolist (ch '(#\a #\b #\c))
    (on-key (char-code ch)))
  (fiveam:is (string= "abc" (input-string)))
  ;; ncurses returns 263 (KEY_BACKSPACE) when keypad is enabled
  (on-key 263)
  (fiveam:is (string= "ab" (input-string))))

(fiveam:test test-on-key-focus-command
  "Contract 1: /focus command parses project name."
  (init-state)
  (dolist (ch (coerce "/focus myapp" 'list))
    (on-key (char-code ch)))
  (on-key 343)
  (let ((msg (aref (st :messages) 0)))
    (fiveam:is (eq :system (getf msg :role)))))

(fiveam:test test-on-key-scope-command
  "Contract 1: /scope command with valid argument."
  (init-state)
  (dolist (ch (coerce "/scope memex" 'list))
    (on-key (char-code ch)))
  (on-key 343)
  (let ((msg (aref (st :messages) 0)))
    (fiveam:is (eq :system (getf msg :role)))))

(fiveam:test test-on-key-unfocus-command
  "Contract 1: /unfocus command dispatches correctly."
  (init-state)
  (dolist (ch (coerce "/unfocus" 'list))
    (on-key (char-code ch)))
  (on-key 343)
  (let ((msg (aref (st :messages) 0)))
    (fiveam:is (eq :system (getf msg :role)))))

(fiveam:test test-on-key-tab-completion
  "Contract 1: Tab completes / commands when input starts with /."
  (init-state)
  (dolist (ch (coerce "/ev" 'list))
    (on-key (char-code ch)))
  (on-key 9)
  (fiveam:is (string= "/eval " (input-string))))

(fiveam:test test-on-key-tab-no-slash
  "Contract 1: Tab does nothing when input doesn't start with /."
  (init-state)
  (dolist (ch (coerce "hello" 'list))
    (on-key (char-code ch)))
  (on-key 9)
  (fiveam:is (string= "hello" (input-string))))

(fiveam:test test-on-key-multiline
  "Contract 1: \\ + Enter inserts newline instead of sending."
  (init-state)
  (dolist (ch (coerce "line1" 'list))
    (on-key (char-code ch)))
  (on-key (char-code #\\))
  (on-key 343)
  (fiveam:is (search "line1" (input-string)))
  (fiveam:is (search (string #\Newline) (input-string))))

(fiveam:test test-on-key-help
  "Contract 1: /help displays command list."
  (init-state)
  (dolist (ch (coerce "/help" 'list))
    (on-key (char-code ch)))
  (on-key 343)
  (let ((msgs (st :messages)))
    (fiveam:is (>= (length msgs) 3))
    (fiveam:is (some (lambda (m) (search "/eval" (getf m :content))) msgs))))

(fiveam:test test-activity-indicator
  "Contract model: :busy flag is set on send and cleared on agent response."
  (init-state)
  (fiveam:is (eq nil (st :busy)))
  ;; Simulate sending a normal message (sets busy)
  (dolist (ch (coerce "hello" 'list))
    (on-key (char-code ch)))
  (on-key 343)
  (fiveam:is (eq t (st :busy)))
  ;; Simulate receiving an agent response (clears busy)
  (on-daemon-msg '(:type :event :payload (:text "hi back")))
  (fiveam:is (eq nil (st :busy))))

(fiveam:test test-theme
  "Contract view: *tui-theme* provides color mappings."
  (fiveam:is (eq :green (getf *tui-theme* :user)))
  (fiveam:is (eq :white (getf *tui-theme* :agent)))
  (fiveam:is (eq :yellow (getf *tui-theme* :system)))
  (fiveam:is (eq :cyan (getf *tui-theme* :input)))
  (fiveam:is (eq :white (theme-color :unknown-role))))

(fiveam:test test-on-key-ctrl-u-clears
  "Contract 1/v0.7.0: Ctrl+U clears the input buffer."
  (init-state)
  (dolist (ch '(#\h #\i)) (on-key (char-code ch)))
  (on-key 21) ; Ctrl+U
  (fiveam:is (string= "" (input-string))))

(fiveam:test test-on-key-ctrl-l-redraws
  "Contract 1/v0.7.0: Ctrl+L sets all dirty flags."
  (init-state)
  (setf (st :dirty) (list nil nil nil))
  (on-key 12) ; Ctrl+L
  (let ((d (st :dirty)))
    (fiveam:is (eq t (first d)))
    (fiveam:is (eq t (second d)))))

(fiveam:test test-scroll-notify
  "Contract/v0.7.0: add-msg sets scroll-notify when scrolled up."
  (init-state)
  (setf (st :scroll-at-bottom) nil)
  (add-msg :agent "hi")
  (fiveam:is (eq t (st :scroll-notify)))
  (setf (st :scroll-at-bottom) t (st :scroll-notify) nil)
  (add-msg :agent "hi2")
  (fiveam:is (eq nil (st :scroll-notify))))

(fiveam:test test-tab-subcommand
  "Contract/v0.7.0: Tab completes subcommand for /theme."
  (init-state)
  (dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch)))
  (on-key 9)
  (fiveam:is (search "dark" (input-string) :test #'char-equal)))

;; ── v0.7.1 Streaming ──

(fiveam:test test-stream-chunk-appends
  "Contract/v0.7.1: stream-chunk frame appends to last message."
  (init-state)
  (on-daemon-msg '(:type :stream-chunk :payload (:text "Hello")))
  (on-daemon-msg '(:type :stream-chunk :payload (:text " world")))
  (let ((msgs (st :messages)))
    (fiveam:is (= 1 (length msgs)))
    (let ((msg (aref msgs 0)))
      (fiveam:is (eq :agent (getf msg :role)))
      (fiveam:is (string= "Hello world" (getf msg :content)))
      (fiveam:is (eq t (getf msg :streaming))))))

(fiveam:test test-stream-chunk-final
  "Contract/v0.7.1: final empty chunk stamps timestamp and clears streaming flag."
  (init-state)
  (on-daemon-msg '(:type :stream-chunk :payload (:text "Hi")))
  (on-daemon-msg '(:type :stream-chunk :payload (:text "")))
  (let ((msg (aref (st :messages) 0)))
    (fiveam:is (stringp (getf msg :time)))
    (fiveam:is (string= "Hi" (getf msg :content)))
    (fiveam:is (null (st :streaming-text)))))

(fiveam:test test-stream-interrupt
  "Contract/v0.7.1: Esc during streaming appends [interrupted] and finalizes."
  (init-state)
  (on-daemon-msg '(:type :stream-chunk :payload (:text "partial")))
  (on-key 27)
  (let ((msg (aref (st :messages) 0)))
    (fiveam:is (stringp (getf msg :time)))
    (fiveam:is (search "[interrupted]" (getf msg :content)))
    (fiveam:is (null (st :streaming-text)))
    (fiveam:is (null (st :busy)))))

(fiveam:test test-stream-check-skip
  "Contract/v0.7.1: Esc without active streaming does nothing."
  (init-state)
  (on-key 27)
  (fiveam:is (null (st :streaming-text)))
  (fiveam:is (= 0 (length (st :messages)))))

(fiveam:test test-tab-open-url
  "Contract/v0.7.1: Tab on empty input with URL message extracts URL."
  (init-state)
  (add-msg :agent "visit https://example.com for info")
  (on-key 9)
  (fiveam:is (string= "https://example.com" (st :url-buffer))))

;; ── v0.7.2 HITL Panels ──

(fiveam:test test-hitl-panel-in-on-daemon-msg
  "Contract v0.7.2: approval-required messages render as HITL panels."
  (init-state)
  (on-daemon-msg '(:type :EVENT :level :approval-required
                    :payload (:sensor :approval-required
                              :action (:TYPE :REQUEST :PAYLOAD (:TOOL "shell"))
                              :message "rm -rf blocked")))
  (let ((m (aref (st :messages) 0)))
    (fiveam:is (eq :system (getf m :role)))
    (fiveam:is (getf m :panel))
    (fiveam:is (search "rm -rf" (getf m :content)))))

(fiveam:test test-hitl-panel-after-approve
  "Contract v0.7.2: /approve adds confirmation and marks panel resolved."
  (init-state)
  (on-daemon-msg '(:type :EVENT :level :approval-required
                    :payload (:sensor :approval-required :message "test")))
  (dolist (ch (coerce "/approve HITL-test" 'list))
    (on-key (char-code ch)))
  (on-key 13)
  ;; Panel message (index 0) should be marked resolved
  (let ((m (aref (st :messages) 0)))
    (fiveam:is (getf m :panel))
    (fiveam:is (eq :approved (getf m :panel-resolved))))
  ;; Last message should be the approval confirmation
  (let ((m (aref (st :messages) (1- (length (st :messages))))))
    (fiveam:is (search "Approved" (getf m :content)))))

(fiveam:test test-hitl-panel-after-deny
  "Contract v0.7.2: /deny marks panel as denied."
  (init-state)
  (on-daemon-msg '(:type :EVENT :level :approval-required
                    :payload (:sensor :approval-required :message "blocked")))
  (dolist (ch (coerce "/deny HITL-deny" 'list))
    (on-key (char-code ch)))
  (on-key 13)
  (let ((m (aref (st :messages) 0)))
    (fiveam:is (getf m :panel))
    (fiveam:is (eq :denied (getf m :panel-resolved)))))

(fiveam:test test-hitl-approve-parsed
  "Contract v0.7.2: /approve HITL-xxxx sends structured event, not raw text."
  (init-state)
  (dolist (ch (coerce "/approve HITL-abcd" 'list))
    (on-key (char-code ch)))
  (on-key 343)
  ;; Should add a system message confirming approval, not a user message
  (let ((msgs (st :messages)))
    (fiveam:is (>= (length msgs) 1))
    (let ((m (aref msgs 0)))
      (fiveam:is (eq :system (getf m :role)))
      (fiveam:is (search "Approved" (getf m :content))))))

(fiveam:test test-hitl-deny-parsed
  "Contract v0.7.2: /deny HITL-xxxx sends structured denial."
  (init-state)
  (dolist (ch (coerce "/deny HITL-xyz" 'list))
    (on-key (char-code ch)))
  (on-key 343)
  (let ((m (aref (st :messages) 0)))
    (fiveam:is (eq :system (getf m :role)))
    (fiveam:is (search "Denied" (getf m :content)))))

;; ── v0.7.2 Undo/Redo ──

(fiveam:test test-undo-command
  "Contract v0.7.2: /undo sends undo event."
  (init-state)
  (dolist (ch (coerce "/undo" 'list))
    (on-key (char-code ch)))
  (on-key 343)
  (let ((m (aref (st :messages) 0)))
    (fiveam:is (eq :system (getf m :role)))
    (fiveam:is (search "Undo" (getf m :content)))))

(fiveam:test test-redo-command
  "Contract v0.7.2: /redo sends redo event."
  (init-state)
  (dolist (ch (coerce "/redo" 'list))
    (on-key (char-code ch)))
  (on-key 343)
  (let ((m (aref (st :messages) 0)))
    (fiveam:is (eq :system (getf m :role)))
    (fiveam:is (search "Redo" (getf m :content)))))

;; ── v0.7.2 Self-help ──

(fiveam:test test-why-command
  "Contract v0.7.2: /why shows gate trace from last message."
  (init-state)
  (add-msg :agent "did something" :gate-trace '((:gate "shell" :result :blocked :reason "rm -rf")))
  (dolist (ch (coerce "/why" 'list))
    (on-key (char-code ch)))
  (on-key 13)
  (let* ((msgs (st :messages))
         (m (aref msgs (1- (length msgs)))))
    (fiveam:is (eq :system (getf m :role)))
    (fiveam:is (search "[BLOCKED]" (getf m :content)))
    (fiveam:is (search "shell" (getf m :content)))))

(fiveam:test test-why-no-trace
  "Contract v0.7.2: /why with no gate trace shows fallback message."
  (init-state)
  (dolist (ch (coerce "/why" 'list))
    (on-key (char-code ch)))
  (on-key 13)
  (let* ((msgs (st :messages))
         (m (aref msgs (1- (length msgs)))))
    (fiveam:is (search "No recent" (getf m :content)))))

;; ── v0.7.2 Gate Trace Toggle (Ctrl+G) ──

(fiveam:test test-ctrlg-toggle-gate-trace
  "Contract v0.7.2: Ctrl+G toggles gate-trace collapse state."
  (init-state)
  (add-msg :agent "test" :gate-trace '((:gate "shell" :result :passed)))
  (on-key 7)  ;; Ctrl+G — first press hides
  (let* ((msgs (st :messages))
         (m (aref msgs (1- (length msgs)))))
    (fiveam:is (search "hidden" (getf m :content))))
  (on-key 7)  ;; second press shows
  (let* ((msgs (st :messages))
         (m (aref msgs (1- (length msgs)))))
    (fiveam:is (search "shown" (getf m :content)))))

(fiveam:test test-ctrlg-no-gate-trace
  "Contract v0.7.2: Ctrl+G with no gate trace shows fallback."
  (init-state)
  (on-key 7)
  (let ((m (aref (st :messages) 0)))
    (fiveam:is (search "No gate trace" (getf m :content)))))

;; ── v0.7.2 Message Search Mode ──

(fiveam:test test-search-mode-activate
  "Contract v0.7.2: /search enters search mode."
  (init-state)
  (add-msg :agent "hello world")
  (add-msg :agent "goodbye")
  (dolist (ch (coerce "/search hello" 'list))
    (on-key (char-code ch)))
  (on-key 13)
  (fiveam:is (eq t (st :search-mode)))
  (fiveam:is (string= "hello" (st :search-query)))
  (fiveam:is (= 1 (length (st :search-matches)))))

(fiveam:test test-search-mode-escape-exits
  "Contract v0.7.2: Escape exits search mode."
  (init-state)
  (add-msg :agent "test")
  (dolist (ch (coerce "/search test" 'list))
    (on-key (char-code ch)))
  (on-key 13)
  (fiveam:is (eq t (st :search-mode)))
  (on-key 27)  ;; Escape
  (fiveam:is (null (st :search-mode))))

(fiveam:test test-search-mode-up-down-nav
  "Contract v0.7.2: Up/Down navigates between search matches."
  (init-state)
  (add-msg :agent "aaa hello bbb")
  (add-msg :agent "ccc hello ddd")
  (add-msg :agent "no match here")
  (dolist (ch (coerce "/search hello" 'list))
    (on-key (char-code ch)))
  (on-key 13)
  (fiveam:is (= 0 (st :search-match-idx)))
  (on-key 258)  ;; Down
  (fiveam:is (= 1 (st :search-match-idx)))
  (on-key 259)  ;; Up
  (fiveam:is (= 0 (st :search-match-idx)))
  (on-key 259)  ;; Up (clamped)
  (fiveam:is (= 0 (st :search-match-idx))))

(fiveam:test test-context-sections
  "Contract v0.7.2: /context shows section breakdown with IDENTITY, TOOLS, LOGS."
  (init-state)
  (add-msg :agent "hello world")
  (dolist (ch (coerce "/context" 'list))
    (on-key (char-code ch)))
  (on-key 13)
  (let ((msgs (st :messages)))
    (fiveam:is (some (lambda (m) (search "IDENTITY" (getf m :content))) msgs))
    (fiveam:is (some (lambda (m) (search "LOGS" (getf m :content))) msgs))
    (fiveam:is (some (lambda (m) (search "TOOLS" (getf m :content))) msgs))))

(fiveam:test test-help-topic-lookup
  "Contract v0.7.2: /help <topic> reads and searches USER_MANUAL.org."
  (init-state)
  (dolist (ch (coerce "/help configuration" 'list))
    (on-key (char-code ch)))
  (on-key 13)
  (let ((msgs (st :messages)))
    (fiveam:is (some (lambda (m) (search ".env" (getf m :content))) msgs))))

(fiveam:test test-pads-page-up
  "Contract v0.7.2: PageUp scrolls by page size (> 5 lines)."
  (init-state)
  (dotimes (i 30) (add-msg :system (format nil "msg ~d" i)))
  (setf (st :scroll-offset) 0)
  (on-key :ppage)
  (fiveam:is (> (st :scroll-offset) 5) "Should scroll by more than 5 lines"))

(fiveam:test test-pads-page-down-clamp
  "Contract v0.7.2: PageDown clamps to 0."
  (init-state)
  (dotimes (i 5) (add-msg :system (format nil "msg ~d" i)))
  (setf (st :scroll-offset) 3)
  (on-key :npage)
  (fiveam:is (= 0 (st :scroll-offset))))
#+end_src

* v0.8.0 Tests — Sidebar, Palette, Theme, Wizard
#+begin_src lisp
(in-package :passepartout-tui-tests)

(fiveam:test test-theme-hex-to-rgb
  "Contract 4: theme-hex-to-rgb parses #RRGGBB to integer triple."
  (multiple-value-bind (r g b) (passepartout.channel-tui::theme-hex-to-rgb "#5E81AC")
    (fiveam:is (= 94 r))
    (fiveam:is (= 129 g))
    (fiveam:is (= 172 b))))

(fiveam:test test-theme-hex-to-rgb-invalid
  "Contract 4: theme-hex-to-rgb returns white for invalid input."
  (multiple-value-bind (r g b) (passepartout.channel-tui::theme-hex-to-rgb "not-a-color")
    (fiveam:is (= 255 r))
    (fiveam:is (= 255 g))
    (fiveam:is (= 255 b))))

(fiveam:test test-sidebar-toggle
  "Contract 7: sidebar-toggle flips :sidebar-visible and sets dirty flags."
  (init-state)
  (setf (st :dirty) (list nil nil nil))
  (passepartout.channel-tui::sidebar-toggle)
  (fiveam:is (eq t (st :sidebar-visible)))
  (fiveam:is (eq t (first (st :dirty))))
  (fiveam:is (eq t (second (st :dirty)))))

(fiveam:test test-ctrl-x-b-toggles-sidebar
  "Contract 5: Ctrl+X then Ctrl+B toggles sidebar."
  (init-state)
  (on-key 24)  ; Ctrl+X
  (fiveam:is (eq t (st :pending-ctrl-x)))
  (on-key 2)   ; Ctrl+B
  (fiveam:is (eq t (st :sidebar-visible))))

(fiveam:test test-ctrl-p-opens-command-palette
  "Contract 6: Ctrl+P opens command palette (pushes dialog with daemon commands)."
  (init-state)
  (on-key 16)  ; Ctrl+P
  (fiveam:is-true (and cl-tty.dialog:*dialog-stack*)))

(fiveam:test test-open-minibuffer-pushes-dialog
  "Contract 7: open-minibuffer pushes a dialog with a select content."
  (let ((cl-tty.dialog:*dialog-stack* nil))
    (passepartout.channel-tui::open-minibuffer)
    (fiveam:is (= 1 (length cl-tty.dialog:*dialog-stack*)))
    (let ((item (first cl-tty.dialog:*dialog-stack*)))
      (fiveam:is (string= "DIALOG" (symbol-name (class-name (class-of item)))))
      (let ((content (cl-tty.dialog:dialog-content item)))
        (fiveam:is (not (null content)))))))

(fiveam:test test-slash-commands-count
  "Contract 6: *slash-commands* has at least 14 entries with :name, :desc, :action."
  (let ((cmds passepartout.channel-tui::*slash-commands*))
    (fiveam:is (>= (length cmds) 14))
    (dolist (c cmds)
      (fiveam:is (stringp (getf c :name)))
      (fiveam:is (stringp (getf c :desc)))
      (fiveam:is (functionp (getf c :action))))))

(fiveam:test test-daemon-commands-count
  "Contract 8: *daemon-commands* has at least 14 entries with :title, :desc, :action, category headers."
  (let ((cmds passepartout.channel-tui::*daemon-commands*))
    (fiveam:is (>= (length cmds) 14))
    (dolist (c cmds)
      (if (getf c :category)
          (fiveam:is (stringp (getf c :title)))
          (progn
            (fiveam:is (stringp (getf c :title)))
            (fiveam:is (stringp (getf c :desc)))
            (fiveam:is (functionp (getf c :action))))))))

(fiveam:test test-minibuffer-handle-key-escape
  "Contract 8: minibuffer-handle-key with Esc pops dialog."
  (let ((cl-tty.dialog:*dialog-stack* nil))
    (passepartout.channel-tui::open-minibuffer)
    (fiveam:is (= 1 (length cl-tty.dialog:*dialog-stack*)))
    (passepartout.channel-tui::minibuffer-handle-key 27)  ; Esc
    (fiveam:is (null cl-tty.dialog:*dialog-stack*))))

(fiveam:test test-minibuffer-handle-key-backspace
  "Contract 8: Backspace pops filter char, then pops dialog on empty."
  (let ((cl-tty.dialog:*dialog-stack* nil))
    (passepartout.channel-tui::open-minibuffer)
    (let ((sel (cl-tty.dialog:dialog-content (first cl-tty.dialog:*dialog-stack*))))
      (setf (cl-tty.select:select-filter sel) "te")
      (passepartout.channel-tui::minibuffer-handle-key 263)  ; Backspace
      (fiveam:is (string= "t" (cl-tty.select:select-filter sel)))
      (passepartout.channel-tui::minibuffer-handle-key 263)  ; Backspace
      (fiveam:is (string= "" (or (cl-tty.select:select-filter sel) ""))))))

(fiveam:test test-croatoan-to-tty-event-arrows
  "Contract 8: croatoan-to-tty-event converts Croatoan key codes to cl-tty key-events."
  (let ((up (passepartout.channel-tui::croatoan-to-tty-event 259)))
    (fiveam:is (cl-tty.input:key-event-p up))
    (fiveam:is (eql :up (cl-tty.input:key-event-key up))))
  (let ((down (passepartout.channel-tui::croatoan-to-tty-event 258)))
    (fiveam:is (eql :down (cl-tty.input:key-event-key down))))
  (let ((enter (passepartout.channel-tui::croatoan-to-tty-event 13)))
    (fiveam:is (eql :enter (cl-tty.input:key-event-key enter))))
  (let ((esc (passepartout.channel-tui::croatoan-to-tty-event 27)))
    (fiveam:is (eql :escape (cl-tty.input:key-event-key esc)))))

#+end_src