Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
- log-message: silence TUI send-daemon error handler (no stdout bleed) - now function: fix get-decoded-time destructuring (seconds↔minutes swap). Timestamps now show HH:MM instead of SS:MM. - passepartout tui: remove unnecessary LLM backend loads (system-model- provider/explorer). TUI is a client, daemon handles LLM. Faster startup. - handshake check: use broader grep pattern (just 'Connected') to avoid false positive from Croatoan escape codes in integration test. - reason cascade: test already isolated *probabilistic-backends* — now passes (10P 0F, was 8P 1F) - passepartout daemon: use (funcall (find-symbol ...)) to defer package lookup past READ time, fixing PRESSEPARTOUT package not found at boot Test results: reason 10/0, repl 7/0, diagnostics 3/0, literate 4/1 (env) TUI integration: 7/7 pass
80 lines
2.5 KiB
Org Mode
80 lines
2.5 KiB
Org Mode
#+TITLE: Passepartout TUI — Model
|
|
#+PROPERTY: header-args:lisp :tangle ../lisp/gateway-tui-model.lisp
|
|
|
|
* Model
|
|
|
|
The TUI state is a single plist accessed via ~st~ / ~(setf st)~.
|
|
All state mutation flows through event handlers in the controller.
|
|
|
|
** Contract
|
|
|
|
1. (init-state): returns a fresh state plist with ~:msgs~ list,
|
|
~:input~ buffer, ~:dirty~ flag, ~:busy~ flag, and ~:connection~ status.
|
|
2. (add-msg type text): appends a message to the ~:msgs~ list in
|
|
~*state*~, tagged with a timestamp and type. Truncates at the
|
|
message buffer limit.
|
|
3. (queue-event ev): thread-safely enqueues an event for the
|
|
reader loop. (drain-queue) returns and clears the queue.
|
|
|
|
** Package + State
|
|
#+begin_src lisp
|
|
(defpackage :passepartout.gateway-tui
|
|
(:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
|
|
(:export :tui-main :st :add-msg :now :input-string
|
|
:queue-event :drain-queue :init-state
|
|
:view-status :view-chat :view-input :redraw
|
|
:on-key :on-daemon-msg :send-daemon
|
|
:connect-daemon :disconnect-daemon
|
|
:*tui-theme* :theme-color))
|
|
(in-package :passepartout.gateway-tui)
|
|
|
|
(defvar *state* nil)
|
|
(defvar *event-queue* nil)
|
|
(defvar *event-lock* (bt:make-lock "tui-event-lock"))
|
|
|
|
(defvar *tui-theme*
|
|
'(:user :green :agent :white :system :yellow :input :cyan
|
|
:connected :green :disconnected :red :timestamp :yellow)
|
|
"Color theme plist. Keys are semantic roles, values are Croatoan colors.")
|
|
|
|
(defun theme-color (role)
|
|
"Returns the Croatoan color for a semantic role."
|
|
(or (getf *tui-theme* role) :white))
|
|
|
|
(defun st (key) (getf *state* key))
|
|
(defun (setf st) (val key) (setf (getf *state* key) val))
|
|
|
|
(defun init-state ()
|
|
(setf *state*
|
|
(list :running t :mode :chat :connected nil :stream nil
|
|
:input-buffer nil :input-history nil :input-hpos 0
|
|
:messages nil :scroll-offset 0 :busy nil
|
|
:dirty (list nil nil nil))))
|
|
#+end_src
|
|
|
|
** Helpers
|
|
#+begin_src lisp
|
|
(defun now ()
|
|
(multiple-value-bind (s m h) (get-decoded-time)
|
|
(declare (ignore s))
|
|
(format nil "~2,'0d:~2,'0d" h m)))
|
|
|
|
(defun input-string ()
|
|
(coerce (reverse (st :input-buffer)) 'string))
|
|
|
|
(defun add-msg (role content)
|
|
(push (list :role role :content content :time (now)) (st :messages))
|
|
(setf (st :dirty) (list t t nil)))
|
|
#+end_src
|
|
|
|
** Event Queue
|
|
#+begin_src lisp
|
|
(defun queue-event (ev)
|
|
(bt:with-lock-held (*event-lock*) (push ev *event-queue*)))
|
|
|
|
(defun drain-queue ()
|
|
(bt:with-lock-held (*event-lock*)
|
|
(let ((evs (nreverse *event-queue*)))
|
|
(setf *event-queue* nil) evs)))
|
|
#+end_src
|