TUI: colored rendering + LLM routing fix + /eval REPL
- 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:
@@ -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."
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user