#+TITLE: Passepartout TUI — Controller
#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-main.lisp

* Controller

Event handlers + daemon I/O + main loop.

** 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),
   ~/help~ lists all commands, ~/eval <expr>~ evaluates a Lisp
   expression, ~/focus <proj>~ switches project context,
   ~/scope <scope>~ changes context scope, ~/unfocus~ pops context,
   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.
   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.

** Event Handlers
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-main.lisp
(in-package :passepartout.channel-tui)

(defun input-text ()
  "Get current input text from the text-input widget."
  (cl-tty.input:text-input-value (st :text-input)))

(defun (setf input-text) (value)
  "Set current input text and reset cursor."
  (setf (cl-tty.input:text-input-value (st :text-input)) value
        (cl-tty.input:text-input-cursor (st :text-input)) (length value)))

(defun handle-submit (text)
  "Called when user presses Enter in the text-input widget."
  (let ((trimmed (string-trim '(#\Space #\Tab) text)))
    (when (> (length trimmed) 0)
      (push trimmed (st :input-history))
      (setf (st :input-hpos) 0 (st :scroll-offset) 0)
      (command-dispatch trimmed)
      ;; Clear input text — replace with a fresh widget with same callbacks
      (setf (st :text-input) (make-text-input-with-callbacks))
      (setf (st :dirty) (list t t t)))))

(defun handle-cancel ()
  "Called when user presses Escape in the text-input widget."
  (cond
    ((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
               (getf (aref (st :messages) idx) :time) (now))))
     (setf (st :streaming-text) nil (st :busy) nil)
     (setf (st :dirty) (list t t nil)))
    ((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"))))

(defun extract-url-from-messages ()
  "Scan agent messages from newest to oldest for a URL. Returns the URL or nil."
  (let ((msgs (st :messages)))
    (dotimes (i (length msgs) nil)
      (let* ((idx (1- (- (length msgs) i)))
             (msg (aref msgs idx))
             (content (getf msg :content))
             (role (getf msg :role)))
        (unless (eq role :agent) (return nil))
        (when content
          (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))))
                (return (subseq content pos end))))))))))

(defun handle-tab (text pos)
  "Called when user presses Tab in the text-input widget.
Returns two values: new-text and new-cursor-pos (or nil if no completion)."
  (declare (ignore pos))
  (cond
    ;; URL extraction on empty input
    ((string= "" text)
     (if (st :url-buffer)
         (progn (add-msg :system (format nil "Opening ~a" (st :url-buffer)))
                (setf (st :url-buffer) nil)
                nil)
         (let ((url (extract-url-from-messages)))
           (when url
             (setf (st :url-buffer) url)
             (add-msg :system (format nil "Press Tab to open ~a" url))
             (setf (st :dirty) (list t t nil)))
           nil)))
    ;; @ 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
         (values (concatenate 'string "@" match) (length (concatenate 'string "@" match))))))
    ;; /theme subcommand
    ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
     (let* ((partial (string-trim '(#\Space) (subseq text 7)))
            (names '("amber" "gold" "terracotta" "sepia" "nord-warm" "monokai-warm"
                      "gruvbox-warm" "light-amber" "catppuccin" "tokyonight" "dracula"
                      "gemini" "mono"))
            (match (if (string= partial "") (first names)
                       (find partial names :test #'string-equal))))
       (when match (values (concatenate 'string "/theme " match)))))
    ;; /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 (values (concatenate 'string "/focus " match)))))
    ;; 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
         (if (member match '("/eval" "/focus" "/scope") :test #'string=)
             (values (concatenate 'string match " "))
             (values match)))))
     (t nil)))


(defun handle-history (direction)
  "Called when user presses Up/Down in the text-input widget.
Returns two values: new-text and new-cursor-pos (or nil if no movement)."
  (let ((h (st :input-history)) (p (st :input-hpos)))
    (if (eq direction :up)
        (when (and h (< p (1- (length h))))
          (incf (st :input-hpos))
          (values (nth (st :input-hpos) h) (length (nth (st :input-hpos) h))))
        (when (> (st :input-hpos) 0)
          (decf (st :input-hpos))
          (if (and h (< (st :input-hpos) (length h)))
              (values (nth (st :input-hpos) h) (length (nth (st :input-hpos) h)))
              (values "" 0))))))

(defun handle-ppage ()
  "Scroll chat up by one page."
  (let ((max-offset (max 0 (- (length (st :messages)) 1))))
    (setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10))))
  (setf (st :dirty) (list nil t nil)))

(defun handle-npage ()
  "Scroll chat down by one page."
  (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10)))
  (setf (st :dirty) (list nil t nil)))

(defun handle-search-navigate (direction)
  "Search mode: move to prev/next match."
  (let* ((matches (st :search-matches))
         (idx (st :search-match-idx))
         (new-idx (if (eq direction :up)
                      (max 0 (1- 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.8.0 — command dispatch table: each command is its own function.
;; Exact-match commands are looked up in *command-table*; prefix
;; commands (e.g. /search <query>) go through command-dispatch-prefix.

(defun cmd-undo (text) (declare (ignore text))
  (send-daemon (list :type :event :payload (list :sensor :undo)))
  (add-msg :system "Undo: restoring memory to previous state"))

(defun cmd-redo (text) (declare (ignore text))
  (send-daemon (list :type :event :payload (list :sensor :redo)))
  (add-msg :system "Redo: restoring memory"))

(defun cmd-why (text) (declare (ignore text))
  (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))
                      (prefix (case result (:passed "✓") (:blocked "✗") (:approval "→") (t "?"))))
                 (add-msg :system (format nil "  ~a ~a~@[: ~a~]" prefix gate reason)))))
    (unless found (add-msg :system "No gate trace on last agent message."))))

(defun cmd-help (text) (declare (ignore text))
  (add-msg :system "Commands: /undo /redo /reconnect /theme /why /quit /help <topic>")
  (add-msg :system "Manual: Introduction, Installation, Configuration, Memex Structure, Safety, Context/Focus, Skills, Tools, Cost, Session Control, Gate Trace, Tags, HITL, Keybindings, Deployment, Troubleshooting"))

(defun cmd-help-topic (text)
  (let ((topic (string-trim '(#\Space) (subseq text 6))))
    (if (> (length topic) 0)
        (let ((results (self-help-lookup topic)))
          (if results
              (dolist (r results)
                (add-msg :system (format nil "~a — ~a" (car r) (cdr r))))
              (add-msg :system (format nil "No help found for '~a'" topic))))
        (cmd-help text))))

(defun cmd-theme (text) (declare (ignore text))
  (add-msg :system (format nil "Theme: user-fg=~a agent-fg=~a system=~a input-fg=~a"
                          (theme-color :user-fg) (theme-color :agent-fg) (theme-color :system) (theme-color :input-fg)))
  (add-msg :system "Presets: amber gold terracotta sepia nord-warm monokai-warm gruvbox-warm light-amber catppuccin tokyonight dracula gemini mono"))

(defun cmd-eval-usage (text) (declare (ignore text))
  (add-msg :system "Usage: /eval (expr)  Evaluate Lisp"))

(defun cmd-audit-usage (text) (declare (ignore text))
  (add-msg :system "/audit <id>  Inspect memory. /audit verify  check integrity."))

(defun cmd-sessions (text) (declare (ignore text))
  (let* ((snaps (passepartout::snapshot-list)) (count (length snaps)))
    (add-msg :system (format nil "Snapshots: ~d. /rewind <n> /resume <n>" count))))

(defun cmd-quit (text) (declare (ignore text))
  (save-history)
  (add-msg :system "* Goodbye *")
  (send-daemon (list :type :event :payload '(:action :quit)))
  (setf (st :running) nil))

(defun cmd-reconnect (text) (declare (ignore text))
  (disconnect-daemon) (add-msg :system "* Reconnecting... *") (connect-daemon)
  (setf (st :dirty) (list t t nil)))

(defun cmd-context (text) (declare (ignore text))
  (add-msg :system "Context summary: /context why <id> or /context dropped"))

(defun cmd-tags (text) (declare (ignore text))
  (let ((tags (or (uiop:getenv "TAG_CATEGORIES") (uiop:getenv "PRIVACY_FILTER_TAGS") "@personal")))
    (add-msg :system (format nil "Tags: ~a" tags))))

;; Prefix command handlers

(defun cmd-search (text)
  (let ((query (string-trim '(#\Space) (subseq text 8))))
    (when (> (length query) 0)
      (let (matches)
        (dotimes (i (length (st :messages)))
          (let* ((msg (aref (st :messages) i)) (content (getf msg :content)))
            (when (and content (search query content :test #'char-equal))
              (push i matches))))
        (setf matches (nreverse matches))
        (setf (st :search-mode) t (st :search-query) query
              (st :search-matches) matches (st :search-match-idx) 0)
        (add-msg :system (format nil "Search: ~d matches for '~a' (1/~d)" (length matches) query (length matches)))
        (when matches (setf (st :scroll-offset) (first matches)))
        (setf (st :dirty) (list nil t nil))))))

(defun cmd-theme-set (text)
  (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" name)))))

(defun cmd-eval (text)
  (let ((code (subseq text 6)))
    (handler-case
        (let ((result (eval (let ((*read-eval* nil)) (read-from-string code)))))
          (add-msg :system (format nil "=> ~a" result)))
      (error (c) (add-msg :system (format nil "Eval error: ~a" c))))))

(defun cmd-audit (text)
  (let ((arg (string-trim '(#\Space) (subseq text 7))))
    (if (string-equal arg "verify")
        (let* ((r (passepartout::audit-verify-hash)) (total (car r)) (missing (cdr r)))
          (add-msg :system (format nil "Memory: ~d objects, ~d missing hashes" total missing)))
        (let ((info (passepartout::audit-node arg)))
          (if info (add-msg :system (format nil "Node ~a: type=~a version=~a hash=~a scope=~a"
                                           (getf info :id) (getf info :type) (getf info :version) (getf info :hash) (getf info :scope)))
              (add-msg :system (format nil "Node ~a not found" arg)))))))

(defun cmd-rewind (text)
  (let ((n (ignore-errors (parse-integer (string-trim '(#\Space) (subseq text 8))))))
    (if n (progn (passepartout::rollback-memory n) (add-msg :system (format nil "Rolled back to snapshot ~d" n)))
        (add-msg :system "Usage: /rewind <number>"))))

(defun cmd-resume (text)
  (let ((n (ignore-errors (parse-integer (string-trim '(#\Space) (subseq text 7))))))
    (if (and n (< n (length (symbol-value 'passepartout::*memory-snapshots*))))
        (progn (passepartout::rollback-memory n) (add-msg :system (format nil "Resumed snapshot ~d" n)))
        (add-msg :system "Usage: /resume <number>"))))

(defun cmd-default (text)
  (add-msg :user text)
  (setf (st :busy) t)
  (send-daemon (list :type :event :payload (list :sensor :user-input :text text))))

(defparameter *command-table*
  (list
   (cons "/undo" #'cmd-undo)
   (cons "/redo" #'cmd-redo)
   (cons "/why" #'cmd-why)
   (cons "/help" #'cmd-help)
   (cons "/theme" #'cmd-theme)
   (cons "/eval" #'cmd-eval-usage)
   (cons "/audit" #'cmd-audit-usage)
   (cons "/sessions" #'cmd-sessions)
   (cons "/quit" #'cmd-quit)
   (cons "/q" #'cmd-quit)
   (cons "/reconnect" #'cmd-reconnect)
   (cons "/context" #'cmd-context)
   (cons "/tags" #'cmd-tags))
  "Alist of (command-string . handler-function) for exact-match commands.")

(defun command-dispatch (text)
  "Handle a submitted command or message. TEXT is the trimmed input.
Called from handle-submit."
  (let ((handler (find text *command-table* :test #'string-equal :key #'car)))
    (if handler
        (funcall (cdr handler) text)
        (command-dispatch-prefix text))))

(defun command-dispatch-prefix (text)
  "Handle prefix-matched commands that take arguments."
  (cond
    ((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)))
    ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search "))
     (cmd-search text))
    ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
     (cmd-theme-set text))
     ((and (>= (length text) 6) (string-equal (subseq text 0 6) "/help ") (> (length text) 6))
      (cmd-help-topic text))
     ((and (>= (length text) 6) (string-equal (subseq text 0 6) "/eval ") (> (length text) 6))
      (cmd-eval text))
    ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/audit "))
     (cmd-audit text))
    ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/rewind "))
     (cmd-rewind text))
     ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/resume "))
      (cmd-resume text))
     ((string-equal text "/config")
      (cmd-config text))
     ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/config "))
      (cmd-config text))
     ((string-equal text "/identity")
      (cmd-identity text))
     ((and (>= (length text) 10) (string-equal (subseq text 0 10) "/identity "))
      (cmd-identity text))
     (t (cmd-default text))))

;; ── Config menu system (hierarchical, data-driven) ──

(defun show-config-submenu (title options)
  "Push a config submenu dialog onto the stack. TITLE becomes the breadcrumb."
  (let ((sel (cl-tty.dialog:make-select :options options
                :on-select (lambda (opt)
                             (let ((val (getf opt :value))
                                   (action (getf opt :action)))
                               (cond (action (funcall action))
                                     ((stringp val)
                                      (pop (st :dialog-stack))
                                      (setf (input-text) val)
                                      (setf (st :dirty) (list nil nil t)))
                                     ((listp val)
                                      (pop (st :dialog-stack))
                                      (send-daemon (list :type :event :payload val))
                                      (add-msg :system (format nil "Sent: ~a" (getf opt :title)))
                                      (setf (st :dirty) (list t t nil)))))))))
    (push (make-instance 'cl-tty.dialog:dialog :title title :content sel)
          (st :dialog-stack))))

(defun show-config-main-menu ()
  "Top-level config menu."
  (show-config-submenu "Config"
    (list (list :title "LLM Providers — Set API keys"
                :action (lambda () (show-providers-menu)))
          (list :title "Model Discovery — List available models"
                :action (lambda () (show-models-menu)))
          (list :title "Cascade — Provider fallback order per slot"
                :action (lambda () (show-cascade-menu)))
          (list :title "Network — Proxy and timeout settings"
                :action (lambda () (show-network-menu)))
          (list :title "Folders — Memex directory paths"
                :action (lambda () (show-folders-menu)))
          (list :title "Identity — Agent identity information"
                :action (lambda () (show-identity-menu))))))

(defun show-providers-menu ()
  "Provider list from .env keys."
  (let ((env (config-env-read)))
    (show-config-submenu "Config > Providers"
      (loop for (name . env-var) in
            '(("OpenAI" . "OPENAI_API_KEY") ("Anthropic" . "ANTHROPIC_API_KEY")
              ("OpenRouter" . "OPENROUTER_API_KEY") ("Groq" . "GROQ_API_KEY")
              ("Gemini" . "GEMINI_API_KEY") ("DeepSeek" . "DEEPSEEK_API_KEY")
              ("NVIDIA" . "NVIDIA_API_KEY"))
            for val = (cdr (assoc env-var env :test #'string-equal))
            collect (list :title (format nil "~a — ~:[not set~;✓ set~]" name val)
                          :value (format nil "/config provider ~(~a~) " (subseq env-var 0 (position #\_ env-var))))))))

(defun show-models-menu ()
  "Model discovery — instructions."
  (show-config-submenu "Config > Models"
    (list (list :title "Test connection from daemon: run /status in Passepartout"
                :value "/status"))))

(defun show-cascade-menu ()
  "Cascade slot selection."
  (show-config-submenu "Config > Cascade"
    (list (list :title "Chat — Provider cascade for chat" :value "/config cascade chat ")
          (list :title "Code — Provider cascade for code" :value "/config cascade code ")
          (list :title "Plan — Provider cascade for planning" :value "/config cascade plan ")
          (list :title "Background — Provider cascade for background" :value "/config cascade background "))))

(defun show-network-menu ()
  "Network settings."
  (show-config-submenu "Config > Network"
    (list (list :title "HTTP Proxy — Set proxy URL" :value "/config proxy ")
          (list :title "Request Timeout — Set timeout in seconds" :value "/config timeout "))))

(defun show-folders-menu ()
  "Folder path settings."
  (show-config-submenu "Config > Folders"
    (loop for key in '("MEMEX_DIR" "PROJECTS_DIR" "DAILY_DIR" "INBOX_DIR"
                        "ZETTELKASTEN_DIR" "AREAS_DIR" "RESOURCES_DIR"
                        "ARCHIVES_DIR" "SYSTEM_DIR")
          collect (list :title (format nil "~a — Set path" key)
                        :value (format nil "/config folder ~a " key)))))

(defun show-identity-menu ()
  "Identity options."
  (show-config-submenu "Config > Identity"
    (list (list :title "Show current identity" :value "/identity")
          (list :title "Load identity from file" :value "/identity "))))

(defun config-env-path ()
  (merge-pathnames ".env"
    (merge-pathnames "passepartout/"
      (merge-pathnames ".config/" (user-homedir-pathname)))))

(defun config-env-read ()
  (let ((file (config-env-path)))
    (when (probe-file file)
      (with-open-file (in file :direction :input)
        (loop for line = (read-line in nil nil)
              while line
              for pos = (position #\= line)
              when pos
              collect (cons (string-trim '(#\Space) (subseq line 0 pos))
                            (string-trim '(#\Space) (subseq line (1+ pos)))))))))

(defun config-env-set (key value)
  (let ((file (config-env-path)))
    (ensure-directories-exist file)
    (let ((entries (config-env-read)))
      (let ((existing (assoc (string key) entries :test #'string-equal)))
        (if existing
            (setf (cdr existing) value)
            (push (cons (string key) value) entries)))
      (with-open-file (out file :direction :output :if-exists :supersede)
        (dolist (e (sort entries #'string-lessp :key #'car))
          (format out "~a=~a~%" (car e) (cdr e)))))))

(defun daemon-send (action-plist)
  "Send a message to the daemon if connected. Returns T if sent."
  (let ((s (st :stream)))
    (when (and s (open-stream-p s))
      (send-daemon (list :type :event :payload action-plist))
      t)))

(defun cmd-config (text)
  "Handle /config commands. Writes .env directly, sends to daemon if connected."
  (let* ((parts (uiop:split-string text :separator '(#\Space)))
         (sub (and (>= (length parts) 2) (second parts))))
    (case (and sub (intern (string-upcase sub) :keyword))
      (:provider
       (let ((name (third parts))
             (key (fourth parts)))
         (if (and name key)
             (let ((env-key (format nil "~a_API_KEY" (string-upcase name))))
               (config-env-set env-key key)
               (daemon-send (list :action :reload-config))
               (add-msg :system (format nil "✓ ~a API key set" name)))
             (add-msg :system "Usage: /config provider <name> <apikey>"))))
      (:test
       (let ((name (third parts)))
         (if (and name (daemon-send (list :action :provider-test :name name)))
             (add-msg :system (format nil "Testing ~a... (response will appear)" name))
             (add-msg :system "* Daemon not running — start passepartout daemon *"))))
      (:models
       (let ((name (third parts)))
         (if (and name (daemon-send (list :action :provider-models :name name)))
             (add-msg :system (format nil "Discovering ~a models... (response will appear)" name))
             (add-msg :system "* Daemon not running — start passepartout daemon *"))))
      (:cascade
       (let ((slot (third parts))
             (cascade (fourth parts)))
         (if cascade
             (let ((env-key (if slot (format nil "~a_CASCADE" (string-upcase slot)) "PROVIDER_CASCADE")))
               (config-env-set env-key cascade)
               (daemon-send (list :action :reload-config))
               (add-msg :system (format nil "✓ ~a cascade: ~a" (or slot "global") cascade)))
             (add-msg :system (format nil "Cascade: ~a" (or (cdr (assoc "PROVIDER_CASCADE" (config-env-read) :test #'string-equal)) "not set"))))))
      (:proxy
       (let ((url (third parts)))
         (if url
             (progn (config-env-set "HTTP_PROXY" url)
                    (add-msg :system (format nil "✓ Proxy: ~a" url)))
             (add-msg :system (format nil "Proxy: ~a" (or (cdr (assoc "HTTP_PROXY" (config-env-read) :test #'string-equal)) "not set"))))))
      (:timeout
       (let ((n (third parts)))
         (if n
             (progn (config-env-set "LLM_REQUEST_TIMEOUT" n)
                    (add-msg :system (format nil "✓ Timeout: ~as" n)))
             (add-msg :system (format nil "Timeout: ~as" (or (cdr (assoc "LLM_REQUEST_TIMEOUT" (config-env-read) :test #'string-equal)) "30"))))))
      (:folder
       (let ((key (third parts))
             (path (fourth parts)))
         (if path
             (progn (config-env-set key path)
                    (add-msg :system (format nil "✓ ~a set" key)))
             (add-msg :system (format nil "~a: ~a" key (or (cdr (assoc key (config-env-read) :test #'string-equal)) "not set"))))))
      (t (add-msg :system "Usage: /config provider <name> <key> | /config cascade <slot> <providers> | /config proxy <url> | /config timeout <n> | /config folder <key> <path> | /config test <name> | /config models <name>")))))

(defun cmd-identity (text)
  "Handle /identity: show or load identity from IDENTITY.org directly."
  (if (> (length text) 9)
      (let ((path (string-trim '(#\Space) (subseq text 10))))
        (if (> (length path) 0)
            (if (probe-file path)
                (let ((id (uiop:read-file-string path)))
                  (add-msg :system (format nil "✓ Loaded identity from ~a" path))
                  (add-msg :system (format nil "~a" (string-trim '(#\Newline) id))))
                (add-msg :system (format nil "File not found: ~a" path)))
            (add-msg :system "Usage: /identity <path> — load identity from file")))
      (let ((path (merge-pathnames "IDENTITY.org" (merge-pathnames "memex/" (user-homedir-pathname)))))
        (if (probe-file path)
            (let ((id (uiop:read-file-string path)))
              (add-msg :system (format nil "Current identity:~%~a" (string-trim '(#\Newline) id))))
            (add-msg :system "No identity set (IDENTITY.org not found)")))))

(defun unified-menu-show (&optional initial-filter)
  "Open the command minibuffer with ALL commands. If INITIAL-FILTER is
supplied (e.g. \"/\"), pre-fill the select filter with it."
  (let* ((on-select (lambda (opt)
                      (let ((val (getf opt :value))
                            (action (getf opt :action)))
                        (cond (action
                               ;; Submenu entry — push new dialog, don't pop
                               (funcall action))
                              ((stringp val)
                               ;; Slash command — fill input buffer, pop dialog
                               (pop (st :dialog-stack))
                               (setf (input-text) val)
                               (setf (st :dirty) (list nil nil t)))
                              ((listp val)
                               ;; Daemon action — send immediately, pop dialog
                               (pop (st :dialog-stack))
                               (send-daemon (list :type :event :payload val))
                               (add-msg :system (format nil "Sent: ~a" (getf opt :title)))
                               (setf (st :dirty) (list t t nil)))))))
         (sel (cl-tty.dialog:make-select :options (all-commands) :on-select on-select)))
    (when initial-filter
      (setf (cl-tty.dialog:select-filter sel) initial-filter))
    (let ((dlg (make-instance 'cl-tty.dialog:dialog :title "Commands" :content sel)))
      (push dlg (st :dialog-stack)))))

;; 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) #\*))
                 (when (and in-section section-content)
                   (push (cons in-section (string-trim '(#\Space #\Newline)
                                                       (format nil "~{~a~^ ~}" (reverse section-content))))
                         results))
                 (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))))))
          (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))
         (gate-trace (getf msg :gate-trace))
         (rule-count (getf payload :rule-count))
         (foveal-id (getf payload :foveal-id))
         (session-cost (getf payload :session-cost)))
    ;; 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))
    (when session-cost (setf (st :session-cost) session-cost))
    (cond
      (text (setf (st :busy) nil)
            (add-msg :agent text :gate-trace gate-trace))
      ((eq action :handshake)
       (setf (st :daemon-version) (getf payload :version)))
      (t (add-msg :agent (format nil "~a" msg))))))
#+END_SRC

** Daemon Communication
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-main.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))))))

(defun save-history ()
  "Save input history to disk for next TUI session."
  (let ((hist-file (merge-pathnames ".cache/passepartout/history"
                                    (user-homedir-pathname))))
    (ensure-directories-exist hist-file)
    (with-open-file (out hist-file :direction :output :if-exists :supersede)
      (dolist (line (reverse (st :input-history)))
        (write-line line out)))))
#+END_SRC

** Connection
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-main.lisp
;; Process a key-event: route through dialog, keymap, navigation, or text-input.
(defun process-key-event (event)
  (let* ((k (cl-tty.input:key-event-key event)))
    (cond
      ((st :dialog-stack)
       (let* ((dlg (car (st :dialog-stack)))
              (sel (cl-tty.dialog:dialog-content dlg)))
         (if (cl-tty.dialog:select-handle-key sel event)
              ;; select-handle-key handled nav or enter + fired callback
              ;; callback handles popping (slash commands pop, submenus don't)
              nil
             ;; not handled: escape, char input, backspace
             (cond
               ((eql k :escape)
                (pop (st :dialog-stack)))
               ((let ((ch (code-char (cl-tty.input:key-event-code event))))
                  (and ch (graphic-char-p ch)
                       (setf (cl-tty.dialog:select-filter sel)
                             (concatenate 'string
                               (or (cl-tty.dialog:select-filter sel) "")
                               (string ch))))))
               ((eql k :backspace)
                (let ((f (cl-tty.dialog:select-filter sel)))
                  (when (> (length (or f "")) 0)
                    (setf (cl-tty.dialog:select-filter sel)
                          (subseq f 0 (1- (length f)))))))))
         (setf (st :dirty) (list t t nil))))
      ((cl-tty.input:dispatch-key-event event)
       (setf (st :dirty) (list t t nil)))
      ((member k '(:ppage :npage))
       (if (eq k :ppage) (handle-ppage) (handle-npage)))
      (t (let ((code (cl-tty.input:key-event-code event)))
           (if (and code (char= (code-char code) #\/)
                    (null (st :dialog-stack))
                    (zerop (length (input-text))))
               (unified-menu-show "/")
               (handler-case
                   (progn
                     (cl-tty.input:handle-text-input (st :text-input) event)
                     (setf (st :dirty) (list nil nil t)))
                  (error (c)
                    (add-msg :system (format nil "* Input error: ~a *" c))))))))))

(defun connect-daemon (&optional (host "127.0.0.1") (start-port 9105) (end-port 9115))
  "Try to connect to daemon once across START-PORT to END-PORT.
Returns T on success, nil on failure. Does NOT wait or retry."
  (loop for port from start-port to end-port
        do (handler-case
               (let ((s (usocket:socket-connect host port :timeout 2)))
                 (setf (st :stream) (usocket:socket-stream s)
                       (st :connected) t)
                 (bt:make-thread (lambda () (reader-loop (st :stream)))
                                :name "tui-reader")
                 (return-from connect-daemon t))
             (usocket:connection-refused-error () nil)
             (error (c) nil)))
  nil)

(defun disconnect-daemon ()
  (when (st :stream)
    (ignore-errors (close (st :stream)))
    (setf (st :stream) nil (st :connected) nil)
    (add-msg :system (format nil "* Disconnected [now=~a] *" (now)))))
#+END_SRC

** Main Loop
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-main.lisp

;; v0.8.0 — Global keymap
(eval-when (:load-toplevel :execute)
  (cl-tty.input:defkeymap :global
    (:ctrl+q (lambda (e) (declare (ignore e))
               (setf (st :running) nil)))
    (:ctrl+p (lambda (e) (declare (ignore e))
               (unified-menu-show)))
    (:ctrl+b (lambda (e) (declare (ignore e))
               (setf (st :sidebar-mode)
                     (case (st :sidebar-mode)
                       (:auto :visible)
                       (:visible :hidden)
                       (:hidden :auto)))
               (setf (st :dirty) (list t t nil))))
    (:ppage (lambda (e) (declare (ignore e))
              (let ((max-offset (max 0 (- (length (st :messages)) 1))))
                (setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10))))
              (setf (st :dirty) (list nil t nil))))
    (:npage (lambda (e) (declare (ignore e))
              (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10)))
              (setf (st :dirty) (list nil t nil))))
    ;; v0.9.0 — Readline keybindings (Ctrl+A/E/U/W/K handled by text-input widget)
    (:ctrl+y (lambda (e) (declare (ignore e))
              (let ((killed (st :kill-ring)))
                (when killed
                  (let ((cur (input-text)))
                    (setf (input-text) (concatenate 'string cur killed)))
                  (setf (st :dirty) (list nil nil t))))))
    (:ctrl+l (lambda (e) (declare (ignore e))
              (setf (st :dirty) (list t t t))))
    (:ctrl+d (lambda (e) (declare (ignore e))
              (when (string= "" (input-text))
                (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))))
    (:ctrl+f (lambda (e) (declare (ignore e))
              (add-msg :system "Use /search <query> to find messages")))
    (:ctrl+g (lambda (e) (declare (ignore e))
              (let ((gate-idx nil))
                (loop for i from (1- (length (st :messages))) downto 0
                      for m = (aref (st :messages) i)
                      when (and (getf m :gate-trace) (listp (getf m :gate-trace)))
                      do (setf gate-idx i) (loop-finish))
                (if gate-idx
                    (let ((cg (st :collapsed-gates)))
                      (if (member gate-idx cg)
                          (setf (st :collapsed-gates) (remove gate-idx cg))
                          (push gate-idx (st :collapsed-gates)))
                      (add-msg :system (format nil "Gate trace ~a for msg ~a"
                                              (if (member gate-idx (st :collapsed-gates)) "hidden" "shown")
                                              gate-idx))
                      (setf (st :dirty) (list nil t nil)))
                    (add-msg :system "No gate trace to toggle")))))
    (:alt+enter (lambda (e) (declare (ignore e))
                  (let ((cur (input-text)))
                    (setf (input-text) (concatenate 'string cur (string #\Newline))))
                  (setf (st :dirty) (list nil nil t))))
    ;; v0.9.0 — Ctrl+X prefix + help
    (:ctrl+x (lambda (e) (declare (ignore e))
              (setf (st :pending-ctrl-x) t)))
    (:? (lambda (e) (declare (ignore e))
          (add-msg :system "Keybindings: Ctrl+P palette | Ctrl+B sidebar | Ctrl+F search | Ctrl+L redraw | Ctrl+D quit | Ctrl+Q quit | PageUp/Dn scroll | Esc interrupt | Tab complete | Up/Dn history")
          (add-msg :system "Commands: /eval <expr> | /undo | /redo | /why | /identity | /tags | /audit | /search | /context | /focus | /scope | /unfocus | /theme | /reconnect | /help")
          (setf (st :dirty) (list t t nil))))))
 
;; v0.8.0 — Prompt/local keymap (for when input is active)
(eval-when (:load-toplevel :execute)
  (cl-tty.input:defkeymap :local
    (:ppage (lambda (e) (declare (ignore e)) (handle-ppage)))
    (:npage (lambda (e) (declare (ignore e)) (handle-npage)))))

(defvar *cat-proc* nil "Cat subprocess for keyboard input (unused — direct stdin reads)")
(defvar *tty-in* nil "Stream from cat subprocess stdout (unused — direct stdin reads)")

(defun make-text-input-with-callbacks ()
  "Create a text-input widget with the standard passepartout callbacks."
  (cl-tty.input:make-text-input
    :on-submit #'handle-submit
    :on-cancel #'handle-cancel
    :on-tab #'handle-tab
    :on-history #'handle-history))

(defun tui-main ()
  (init-state)
  (setf (st :text-input) (make-text-input-with-callbacks))
  (load-history)
  (theme-load)
  (let* ((swank-port (or (ignore-errors
                           (parse-integer (uiop:getenv "TUI_SWANK_PORT")))
                         4006)))
    (setf (st :dirty) (list t t t))
    ;; Quick sync connect attempt (just 3 ports, 6s max)
    (let ((connected (connect-daemon "127.0.0.1" 9105 9107)))
      (unless connected
        (add-msg :system "* Daemon not found — will retry in background... *")))
    (when (> swank-port 0)
      (handler-case
          (progn
             (ql:quickload :swank :silent t)
             (let ((*standard-output* (make-string-output-stream))
                   (*error-output* (make-string-output-stream)))
               (funcall (find-symbol "CREATE-SERVER" "SWANK")
                        :port swank-port :dont-close t))
              (values))
        (error ()
          (add-msg :system "* Swank unavailable *"))))
    (cl-tty.backend:with-terminal (be w h)
           ;; stty -icanon -echo -ixon is set by the bash script.
           ;; We read directly from SBCL's stdin (fd 0) since the
           ;; terminal is in raw mode — no cat subprocess needed.
           ;; Initial dirty all to trigger first redraw in loop
           (setq w (or (and (numberp w) (> w 0) w) 80)
                 h (or (and (numberp h) (> h 0) h) 24))
           ;; Retry daemon connection in background if sync attempt failed
           (unless (st :connected)
             (add-msg :system "* Connecting to daemon... *")
             (bt:make-thread
                 (lambda ()
                   (loop while (and (st :running) (not (st :connected)))
                         do (connect-daemon)
                         (unless (st :connected) (sleep 5))))
                  :name "daemon-auto-connect"))
            ;; Initial render before first read-event (which may block)
            (unless (st :dialog-stack)
              (redraw be w h))
            (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 *"))))


                 ;; Keyboard reader via cl-tty.input:read-event (handles CSI, SS3, UTF-8, resize)
                 (handler-case
                     (multiple-value-bind (ev resize-data)
                         (cl-tty.input:read-event be :timeout 0.1)
                       (cond
                         ((eq ev :resize)
                          (let ((new-size resize-data))
                            (setq w (car new-size) h (cdr new-size))
                            (setf (st :dirty) (list t t t))))
                          ((cl-tty.input:key-event-p ev)
                            (process-key-event ev))))
                    (error (c)
                      (add-msg :system (format nil "* Reader error: ~a *" c))))
                 ;; Guard w and h before render (resize or other code may have set them to nil)
               (setq w (or (and (numberp w) (> w 0) w) 80)
                     h (or (and (numberp h) (> h 0) h) 24))
                                (unless (st :dialog-stack)
                  (redraw be w h))
               (let ((ds (st :dialog-stack)))
                  (when ds
                      (cl-tty.backend:begin-sync be)
                      (let* ((chat-w (- w (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0)))
                             (dlg (car ds))
                             (sel (cl-tty.dialog:dialog-content dlg))
                             (filtered (cl-tty.dialog:select-filtered-options sel))
                             (cnt (length filtered))
                             (mh (min 15 (1+ cnt)))
                             (panel-top (input-panel-top chat-w h))
                             (top (max 0 (- panel-top mh))))
                        (cl-tty.dialog:render-select-minibuffer
                          be 0 top chat-w (- h top) sel
                          (cl-tty.dialog:dialog-title dlg)
                          (list :bg-panel (theme-color :bg-panel)
                                :separator (theme-color :separator)
                                :accent (theme-color :accent)
                                :text-muted (theme-color :text-muted)
                                :agent-fg (theme-color :agent-fg)
                                :input-fg (theme-color :input-fg)
                                :bg-input (theme-color :bg-input)
                                :input-prompt (theme-color :input-prompt))))
                       (cl-tty.backend:end-sync be))
                   (sleep 0.1)))
                (progn (disconnect-daemon)))))
#+END_SRC

* Test Suite
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-main.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)

;; Test helpers: concise wrappers over process-key-event
(defun simulate-typing (string)
  (dolist (ch (coerce string 'list))
    (passepartout.channel-tui::process-key-event
     (cl-tty.input:make-key-event
      :key (intern (string ch) :keyword) :code (char-code ch)))))

(defun simulate-key (key &optional code)
  (passepartout.channel-tui::process-key-event
   (cl-tty.input:make-key-event :key key :code (or code 0))))

(defun simulate-ctrl (key)
  (passepartout.channel-tui::process-key-event
   (cl-tty.input:make-key-event
    :key key :ctrl t :code (- (char-code key) 64))))

(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-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)
  (simulate-typing "hello")
  (simulate-key :enter)
  (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: *theme* provides color mappings via theme-color."
  (fiveam:is (string= "#fab283" (theme-color :user-fg)))
  (fiveam:is (string= "#e8e8e8" (theme-color :agent-fg)))
  (fiveam:is (string= "#808080" (theme-color :system)))
  (fiveam:is (string= "#e8e8e8" (theme-color :input-fg)))
  (fiveam:is (string= "#FFFFFF" (theme-color :unknown-role))))

(fiveam:test test-on-key-ctrl-l-redraws
  "Contract v0.9.0: Ctrl+L (via dispatch-key-event) sets all dirty flags."
  (init-state)
  (setf (st :dirty) (list nil nil nil))
  (cl-tty.input:dispatch-key-event
   (cl-tty.input:make-key-event :key :l :ctrl t :code 12))
  (let ((d (st :dirty)))
    (fiveam:is (eq t (first d)))
    (fiveam:is (eq t (second d)))))

(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)
  (multiple-value-bind (new-text new-pos)
      (passepartout.channel-tui::handle-tab "/theme " 7)
    (declare (ignore new-pos))
    (fiveam:is (search "amber" new-text :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")))
  (simulate-key :escape)
  (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)
  (simulate-key :escape)
  (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")
  (simulate-key :tab)
  (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")))
  (passepartout.channel-tui::command-dispatch "/approve HITL-test")
  ;; 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")))
  (passepartout.channel-tui::command-dispatch "/deny HITL-deny")
  (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)
  (passepartout.channel-tui::command-dispatch "/approve HITL-abcd")
  ;; 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)
  (passepartout.channel-tui::command-dispatch "/deny HITL-xyz")
  (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)
  (passepartout.channel-tui::command-dispatch "/undo")
  (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)
  (passepartout.channel-tui::command-dispatch "/redo")
  (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")))
  (passepartout.channel-tui::command-dispatch "/why")
  (let* ((msgs (st :messages))
         (m (aref msgs (1- (length msgs)))))
    (fiveam:is (eq :system (getf m :role)))
    (fiveam:is (search "✗" (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)
  (passepartout.channel-tui::command-dispatch "/why")
  (let* ((msgs (st :messages))
         (m (aref msgs (1- (length msgs)))))
    (fiveam:is (search "No gate trace" (getf m :content)))))

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

(fiveam:test test-ctrlg-toggle-gate-trace
  "Contract v0.9.0: Ctrl+G (via dispatch-key-event) toggles gate-trace collapse state."
  (init-state)
  (add-msg :agent "test" :gate-trace '((:gate "shell" :result :passed)))
  (cl-tty.input:dispatch-key-event
   (cl-tty.input:make-key-event :key :g :ctrl t :code 7))
  (let* ((msgs (st :messages))
         (m (aref msgs (1- (length msgs)))))
    (fiveam:is (search "hidden" (getf m :content))))
  (cl-tty.input:dispatch-key-event
   (cl-tty.input:make-key-event :key :g :ctrl t :code 7))
  (let* ((msgs (st :messages))
         (m (aref msgs (1- (length msgs)))))
    (fiveam:is (search "shown" (getf m :content)))))

(fiveam:test test-ctrlg-no-gate-trace
  "Contract v0.9.0: Ctrl+G (via dispatch-key-event) with no gate trace shows fallback."
  (init-state)
  (cl-tty.input:dispatch-key-event
   (cl-tty.input:make-key-event :key :g :ctrl t :code 7))
  (let ((m (aref (st :messages) 0)))
    (fiveam:is (search "No gate trace" (getf m :content)))))

;; ── 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")
  (passepartout.channel-tui::command-dispatch "/search hello")
  (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")
  (passepartout.channel-tui::command-dispatch "/search test")
  (fiveam:is (eq t (st :search-mode)))
  (simulate-key :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")
  (passepartout.channel-tui::command-dispatch "/search hello")
  (fiveam:is (= 0 (st :search-match-idx)))
  (passepartout.channel-tui::handle-search-navigate :down)
  (fiveam:is (= 1 (st :search-match-idx)))
  (passepartout.channel-tui::handle-search-navigate :up)
  (fiveam:is (= 0 (st :search-match-idx)))
  (passepartout.channel-tui::handle-search-navigate :up)
  (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")
  (passepartout.channel-tui::command-dispatch "/context")
  (let ((msgs (st :messages)))
    (fiveam:is (some (lambda (m) (search "Context summary" (getf m :content))) msgs))))

(fiveam:test test-help-topic-lookup
  "Contract v0.7.2: /help <topic> reads and searches USER_MANUAL.org."
  (init-state)
  (passepartout.channel-tui::command-dispatch "/help")
  (let ((msgs (st :messages)))
    (fiveam:is (some (lambda (m) (search "Commands" (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)
  (simulate-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)
  (simulate-key :npage)
  (fiveam:is (= 0 (st :scroll-offset))))

;; ── v0.8.0 Minibuffer ──

(fiveam:test test-slash-commands-defined
  "Contract v0.8.0: *slash-commands* is non-nil list of option plists."
  (fiveam:is (listp passepartout.channel-tui::*slash-commands*))
  (fiveam:is (> (length passepartout.channel-tui::*slash-commands*) 0))
  (fiveam:is (every (lambda (opt)
                       (and (getf opt :title) (getf opt :value)))
                     passepartout.channel-tui::*slash-commands*)))

(fiveam:test test-minibuffer-state
  "Contract v0.8.0: init-state has :dialog-stack and :minibuffer-active fields."
  (init-state)
  (fiveam:is (null (st :dialog-stack)))
  (fiveam:is (null (st :minibuffer-active))))

(fiveam:test test-command-palette-state
  "Contract v0.8.0: init-state has :command-palette-active and :command-palette-dialog as nil."
  (init-state)
  (fiveam:is (null (st :command-palette-active)))
  (fiveam:is (null (st :command-palette-dialog))))
#+END_SRC