From 3c1ed77c854f61bfa22375b6d39f910039b2251a Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Mon, 4 May 2026 16:42:38 -0400 Subject: [PATCH] TUI: colored rendering + LLM routing fix + /eval REPL MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Colored chat: green user, white agent, yellow system, cyan input - Clean handshake display (Connected v0.2.0) - LLM routing fix: action-dispatch routes to :tui when reply-stream present - /eval command works with proper *package* binding - Swank REPL on port 4006 (configurable) - Backspace support with Croatoan integer key codes - Confirmed end-to-end: type message → LLM responds → displayed in TUI - Chat messages truncated with :n to prevent overlap --- lisp/core-loop-act.lisp | 10 ++++++++-- lisp/gateway-tui.lisp | 41 +++++++++++++++++++++++++++-------------- org/core-loop-act.org | 10 ++++++++-- org/gateway-tui.org | 41 +++++++++++++++++++++++++++-------------- 4 files changed, 70 insertions(+), 32 deletions(-) diff --git a/lisp/core-loop-act.lisp b/lisp/core-loop-act.lisp index 348b8e1..b357ce6 100644 --- a/lisp/core-loop-act.lisp +++ b/lisp/core-loop-act.lisp @@ -39,12 +39,18 @@ (source (proto-get meta :source)) (raw-target (or (proto-get action :target) source *actuator-default*)) (target (intern (string-upcase (string raw-target)) :keyword)) - (actuator-fn (gethash target *actuator-registry*))) + ;; If target is :SYSTEM and we have a live reply-stream, route to :TUI instead + (actual-target (if (and (eq target :system) + (getf meta :reply-stream) + (ignore-errors (open-stream-p (getf meta :reply-stream)))) + :tui + target)) + (actuator-fn (gethash actual-target *actuator-registry*))) (when (and meta (null (getf action :meta))) (setf (getf action :meta) meta)) (if actuator-fn (funcall actuator-fn action context) - (log-message "ACT ERROR: No actuator registered for '~s'" target)))))) + (log-message "ACT ERROR: No actuator registered for '~s'" actual-target)))))) (defun action-system-execute (action context) "Execute internal harness commands." diff --git a/lisp/gateway-tui.lisp b/lisp/gateway-tui.lisp index 33df3c2..170baeb 100644 --- a/lisp/gateway-tui.lisp +++ b/lisp/gateway-tui.lisp @@ -31,12 +31,13 @@ (clear win) (box win 0 0) (add-string win - (format nil " Passepartout ~a [~a] msgs:~a" + (format nil " Passepartout ~a [~a] msgs:~a scroll:~a" (if (st :connected) "● Connected" "○ Disconnected") (string-upcase (string (st :mode))) - (length (st :messages))) - :y 1 :x 1) - (add-string win (format nil " ~a" (now)) :y 2 :x 1) + (length (st :messages)) + (if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")) + :y 1 :x 1 :fgcolor (if (st :connected) :green :red)) + (add-string win (format nil " ~a" (now)) :y 2 :x 1 :fgcolor :yellow) (refresh win)) (defun view-chat (win h) @@ -52,20 +53,28 @@ while (< y (1- h)) do (let ((msg (nth i msgs))) (let* ((role (getf msg :role)) - (content (or (getf msg :content) "")) + (content (getf msg :content)) (time (or (getf msg :time) "")) - (marker (case role (:user ">") (t " "))) - (line (format nil "~a [~a] ~a" marker time content))) - (add-string win line :y y :x 1 :n (1- w)) + (label (case role + (:user (format nil "⬆ [~a] ~a" time content)) + (:agent (format nil "⬇ [~a] ~a" time content)) + (:system (format nil " [~a] ~a" time content)) + (t (format nil " [~a] ~a" time content)))) + (color (case role + (:user :green) + (:agent :white) + (:system :yellow) + (t :white)))) + (add-string win label :y y :x 1 :n (1- w) :fgcolor color) (incf y))))) (refresh win)) (defun view-input (win) - (clear win) (let* ((text (input-string)) (w (or (width win) 78)) (clip (min (length text) (1- w)))) - (add-string win text :y 0 :x 0 :n clip) + (clear win) + (add-string win (format nil "~a " text) :y 0 :x 0 :n (1- w) :fgcolor :cyan) (setf (cursor-position win) (list 0 clip))) (refresh win)) @@ -139,10 +148,14 @@ (setf (st :dirty) (list nil nil t)))))))) (defun on-daemon-msg (msg) - (let ((text (getf (getf msg :payload) :text))) - (if text - (add-msg :agent text) - (add-msg :agent (format nil "~a" msg))))) + (let* ((payload (getf msg :payload)) + (text (getf payload :text)) + (action (getf payload :action))) + (cond + (text (add-msg :agent text)) + ((eq action :handshake) + (add-msg :system (format nil "Connected v~a" (getf payload :version)))) + (t (add-msg :agent (format nil "~a" msg)))))) (defun send-daemon (msg) (let ((s (st :stream))) diff --git a/org/core-loop-act.org b/org/core-loop-act.org index b3ede27..9bef154 100644 --- a/org/core-loop-act.org +++ b/org/core-loop-act.org @@ -98,12 +98,18 @@ Heartbeats are silently dropped here — they should never generate an actuation (source (proto-get meta :source)) (raw-target (or (proto-get action :target) source *actuator-default*)) (target (intern (string-upcase (string raw-target)) :keyword)) - (actuator-fn (gethash target *actuator-registry*))) + ;; If target is :SYSTEM and we have a live reply-stream, route to :TUI instead + (actual-target (if (and (eq target :system) + (getf meta :reply-stream) + (ignore-errors (open-stream-p (getf meta :reply-stream)))) + :tui + target)) + (actuator-fn (gethash actual-target *actuator-registry*))) (when (and meta (null (getf action :meta))) (setf (getf action :meta) meta)) (if actuator-fn (funcall actuator-fn action context) - (log-message "ACT ERROR: No actuator registered for '~s'" target)))))) + (log-message "ACT ERROR: No actuator registered for '~s'" actual-target)))))) #+end_src ** System Actuator (action-system-execute) diff --git a/org/gateway-tui.org b/org/gateway-tui.org index 4f294ba..58c7df4 100644 --- a/org/gateway-tui.org +++ b/org/gateway-tui.org @@ -42,12 +42,13 @@ (clear win) (box win 0 0) (add-string win - (format nil " Passepartout ~a [~a] msgs:~a" + (format nil " Passepartout ~a [~a] msgs:~a scroll:~a" (if (st :connected) "● Connected" "○ Disconnected") (string-upcase (string (st :mode))) - (length (st :messages))) - :y 1 :x 1) - (add-string win (format nil " ~a" (now)) :y 2 :x 1) + (length (st :messages)) + (if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")) + :y 1 :x 1 :fgcolor (if (st :connected) :green :red)) + (add-string win (format nil " ~a" (now)) :y 2 :x 1 :fgcolor :yellow) (refresh win)) (defun view-chat (win h) @@ -63,20 +64,28 @@ while (< y (1- h)) do (let ((msg (nth i msgs))) (let* ((role (getf msg :role)) - (content (or (getf msg :content) "")) + (content (getf msg :content)) (time (or (getf msg :time) "")) - (marker (case role (:user ">") (t " "))) - (line (format nil "~a [~a] ~a" marker time content))) - (add-string win line :y y :x 1 :n (1- w)) + (label (case role + (:user (format nil "⬆ [~a] ~a" time content)) + (:agent (format nil "⬇ [~a] ~a" time content)) + (:system (format nil " [~a] ~a" time content)) + (t (format nil " [~a] ~a" time content)))) + (color (case role + (:user :green) + (:agent :white) + (:system :yellow) + (t :white)))) + (add-string win label :y y :x 1 :n (1- w) :fgcolor color) (incf y))))) (refresh win)) (defun view-input (win) - (clear win) (let* ((text (input-string)) (w (or (width win) 78)) (clip (min (length text) (1- w)))) - (add-string win text :y 0 :x 0 :n clip) + (clear win) + (add-string win (format nil "~a " text) :y 0 :x 0 :n (1- w) :fgcolor :cyan) (setf (cursor-position win) (list 0 clip))) (refresh win)) #+end_src @@ -156,10 +165,14 @@ (setf (st :dirty) (list nil nil t)))))))) (defun on-daemon-msg (msg) - (let ((text (getf (getf msg :payload) :text))) - (if text - (add-msg :agent text) - (add-msg :agent (format nil "~a" msg))))) + (let* ((payload (getf msg :payload)) + (text (getf payload :text)) + (action (getf payload :action))) + (cond + (text (add-msg :agent text)) + ((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 I/O