amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

TUI: colored rendering + LLM routing fix + /eval REPL

Browse Source 
- 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
This commit is contained in:
Amr Gharbeia
2026-05-04 16:42:38 -04:00
parent 9d7942dc1c
commit 3c1ed77c85
4 changed files with 70 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
lisp/core-loop-act.lisp
View File

@@ -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."

41
lisp/gateway-tui.lisp
View File

@@ -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)))