Amr Gharbeia
ef4ea1db1b
- Fix skill loader export: unintern before import (handle existing symbols) - Add ignore-errors around export (handle package conflicts) - Add test-provider-connection (live API key testing for TUI config) - Add *slot-descriptions* with per-slot explanations for TUI config screen - Rewrite gateway-tui with expanding minibuffer config panel (F2 toggle) - Fix skill loader exclusion list: add system-model-router - All org files updated with proper prose
293 lines
12 KiB
Common Lisp
293 lines
12 KiB
Common Lisp
(in-package :passepartout)
|
|
|
|
(defvar *stream* nil "TCP stream to daemon")
|
|
(defvar *input-buffer* nil "Current input line as reversed char list")
|
|
(defvar *input-history* nil "Sent messages (newest first)")
|
|
(defvar *input-history-pos* 0 "Position in input history for nav")
|
|
(defvar *chat-history* nil "List of (direction . text) entries")
|
|
(defvar *chat-scroll-pos* 0 "How many lines from bottom we scrolled up")
|
|
(defvar *is-running* t "Main loop flag")
|
|
(defvar *tui-mode* :chat "Current mode: :chat or :config")
|
|
(defvar *config-selection* 0 "Selected menu item in config panel")
|
|
(defvar *config-panel-height* 10 "Height of config panel when open")
|
|
|
|
(defun send-message (stream msg)
|
|
"Send a framed s-expression over TCP."
|
|
(let* ((sexp (format nil "(~a)" msg))
|
|
(len (length sexp))
|
|
(header (format nil "~6,'0x" len)))
|
|
(write-sequence (babel:string-to-octets (concatenate 'string header sexp)) stream)
|
|
(force-output stream)
|
|
(log-message "SENT: ~a" sexp)))
|
|
|
|
(defun read-message (stream)
|
|
"Read a framed s-expression from TCP."
|
|
(handler-case
|
|
(let* ((header (make-array 6 :element-type '(unsigned-byte 8)))
|
|
(read (read-sequence header stream)))
|
|
(when (< read 6) (return-from read-message nil))
|
|
(let* ((hex (babel:octets-to-string header))
|
|
(len (parse-integer hex :radix 16 :junk-allowed t))
|
|
(buf (make-array len :element-type '(unsigned-byte 8))))
|
|
(read-sequence buf stream)
|
|
(read-from-string (babel:octets-to-string buf))))
|
|
(error () nil)))
|
|
|
|
(defvar *message-queue* nil
|
|
"List of incoming daemon messages from reader thread.")
|
|
(defvar *message-queue-lock* (bt:make-lock "msg-queue-lock")
|
|
"Lock for thread-safe queue access.")
|
|
|
|
(defun message-queue-push (msg)
|
|
(bt:acquire-lock *message-queue-lock*)
|
|
(push msg *message-queue*)
|
|
(bt:release-lock *message-queue-lock*))
|
|
|
|
(defun message-queue-drain ()
|
|
"Drain all messages from queue. Returns list in FIFO order."
|
|
(bt:acquire-lock *message-queue-lock*)
|
|
(let ((msgs (nreverse *message-queue*)))
|
|
(setf *message-queue* nil)
|
|
(bt:release-lock *message-queue-lock*)
|
|
msgs))
|
|
|
|
(defun reader-thread (stream)
|
|
"Background thread: reads daemon messages and enqueues them."
|
|
(loop while *is-running*
|
|
do (let ((msg (read-message stream)))
|
|
(when msg
|
|
(message-queue-push msg)))))
|
|
|
|
(defun input-text ()
|
|
"Convert input buffer to string."
|
|
(coerce (reverse *input-buffer*) 'string))
|
|
|
|
(defun input-backspace ()
|
|
(when *input-buffer* (pop *input-buffer*)))
|
|
|
|
(defun input-submit (stream)
|
|
"Send current input buffer content to daemon."
|
|
(let ((text (string-trim '(#\Space) (input-text))))
|
|
(when (> (length text) 0)
|
|
(push text *input-history*)
|
|
(setf *input-history-pos* 0)
|
|
(send-message stream text)
|
|
(push (cons :sent text) *chat-history*)
|
|
(setf *input-buffer* nil))))
|
|
|
|
(defun input-history-nav (dir)
|
|
"Navigate input history. Returns new value or nil."
|
|
(let ((len (length *input-history*)))
|
|
(when (= len 0) (return-from input-history-nav nil))
|
|
(case dir
|
|
(:up (if (< *input-history-pos* (1- len))
|
|
(incf *input-history-pos*)
|
|
nil))
|
|
(:down (if (> *input-history-pos* 0)
|
|
(decf *input-history-pos*)
|
|
(progn (setf *input-history-pos* 0) nil)))))
|
|
(when (>= *input-history-pos* 0)
|
|
(nth *input-history-pos* *input-history*)))
|
|
|
|
(defun timestamp ()
|
|
"Return HH:MM timestamp string."
|
|
(multiple-value-bind (h m) (get-decoded-time)
|
|
(format nil "~2,'0d:~2,'0d" h m)))
|
|
|
|
(defun status-render (win)
|
|
"Draw the status bar."
|
|
(let ((h (or (height win) 3))
|
|
(w (or (width win) 78)))
|
|
(clear win)
|
|
(box win 0 0)
|
|
(add-string win 1 1 (format nil " Passepartout ~a [~a] msgs:~a scroll:~a"
|
|
(if *stream* "● Connected" "○ Disconnected")
|
|
(ecase *tui-mode* (:chat "CHAT") (:config "CONFIG"))
|
|
(length *chat-history*)
|
|
(if (> *chat-scroll-pos* 0) (format nil "~a↑" *chat-scroll-pos*) "0")))
|
|
(add-string win 2 1 (format nil " ~a" (timestamp)))
|
|
(refresh win)))
|
|
|
|
(defun chat-render (win h)
|
|
"Draw the chat history within WIN of height H."
|
|
(clear win)
|
|
(box win 0 0)
|
|
(let* ((max-lines (- h 2))
|
|
(total (length *chat-history*))
|
|
(start (max 0 (- total max-lines *chat-scroll-pos*)))
|
|
(y 1))
|
|
(loop for i from start below total
|
|
do (let ((entry (nth i *chat-history*)))
|
|
(when (and (< y (1- h)) (car entry))
|
|
(let* ((dir (car entry))
|
|
(text (cdr entry))
|
|
(prefix (if (eq dir :sent) "⬆" "⬇"))
|
|
(label (format nil "~a [~a] ~a" prefix (timestamp) text)))
|
|
(add-string win 1 y label)
|
|
(incf y))))))
|
|
(refresh win))
|
|
|
|
(defun input-render (win)
|
|
"Draw the input line."
|
|
(clear win)
|
|
(add-string win 0 0 (input-text))
|
|
(refresh win))
|
|
|
|
(defun config-render (win)
|
|
"Draw the config mini-buffer panel."
|
|
(let ((w (or (width win) 78)))
|
|
(clear win)
|
|
(box win 0 0)
|
|
(add-string win 1 1 "[1] Providers [2] Cascade [3] Models [4] View [q] Back")
|
|
(add-string win 2 1 (format nil "~a providers configured (PROVIDER_CASCADE: ~a)"
|
|
(count-if (lambda (p) (provider-available-p p))
|
|
(mapcar #'car *provider-configs*))
|
|
(mapcar (lambda (k) (string-downcase (string k))) *provider-cascade*)))
|
|
(refresh win)))
|
|
|
|
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
|
|
"Connect to daemon."
|
|
(handler-case
|
|
(let ((s (usocket:socket-connect host port :element-type '(unsigned-byte 8))))
|
|
(setf *stream* (usocket:socket-stream s))
|
|
(setf *message-queue* nil)
|
|
(bt:make-thread (lambda () (reader-thread *stream*)) :name "tui-reader")
|
|
(push (cons :system "* Connected *") *chat-history*)
|
|
(log-message "Connected to ~a:~a" host port)
|
|
t)
|
|
(error (c)
|
|
(push (cons :system (format nil "* Connection failed: ~a *" c)) *chat-history*)
|
|
nil)))
|
|
|
|
(defun disconnect-daemon ()
|
|
"Disconnect from daemon."
|
|
(when *stream*
|
|
(ignore-errors (close *stream*))
|
|
(setf *stream* nil)
|
|
(push (cons :system "* Disconnected *") *chat-history*)))
|
|
|
|
(defun tui-main ()
|
|
"Entry point for the TUI client."
|
|
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
|
|
(let* ((h (or (height scr) 24))
|
|
(w (or (width scr) 80))
|
|
(input-h 1)
|
|
(config-h 0)
|
|
(chat-h (- h input-h config-h 3))
|
|
(status-win (make-instance 'window :height 3 :width (- w 2) :y 0 :x 1))
|
|
(chat-win (make-instance 'window :height chat-h :width (- w 2) :y 3 :x 1))
|
|
(config-win (make-instance 'window :height 0 :width (- w 2) :y (- h input-h config-h 1) :x 1))
|
|
(input-win (make-instance 'window :height 1 :width (- w 2) :y (- h 1) :x 1)))
|
|
(setf *is-running* t *tui-mode* :chat *input-buffer* nil)
|
|
(connect-daemon)
|
|
(setf *chat-scroll-pos* 0)
|
|
(status-render status-win)
|
|
(chat-render chat-win chat-h)
|
|
(input-render input-win)
|
|
(loop :while *is-running* :do
|
|
;; drain message queue
|
|
(dolist (msg (message-queue-drain))
|
|
(push (cons :received (let ((p (proto-get msg :payload)))
|
|
(or (proto-get p :text) (format nil "~a" msg))))
|
|
*chat-history*))
|
|
;; handle input
|
|
(let ((ch (get-char input-win)))
|
|
(when (and ch (not (equal ch -1)))
|
|
(cond
|
|
;; F2: toggle config panel
|
|
((or (eq ch :f2) (and (integerp ch) (= ch 265)))
|
|
(if (eq *tui-mode* :chat)
|
|
(progn
|
|
(setf *tui-mode* :config)
|
|
(setf *config-panel-height* 10)
|
|
(setf config-h *config-panel-height*)
|
|
(setf chat-h (- h input-h config-h 3))
|
|
(resize chat-win chat-h (- w 2))
|
|
(resize config-win config-h (- w 2))
|
|
(config-render config-win))
|
|
(progn
|
|
(setf *tui-mode* :chat)
|
|
(setf config-h 0)
|
|
(setf chat-h (- h input-h 3))
|
|
(resize chat-win chat-h (- w 2))
|
|
(resize config-win 0 (- w 2))
|
|
(chat-render chat-win chat-h)))
|
|
(status-render status-win))
|
|
;; Config mode key handling
|
|
((eq *tui-mode* :config)
|
|
(cond
|
|
((or (eql ch #\q) (eql ch #\Q))
|
|
(setf *tui-mode* :chat config-h 0 chat-h (- h input-h 3))
|
|
(resize chat-win chat-h (- w 2))
|
|
(resize config-win 0 (- w 2))
|
|
(chat-render chat-win chat-h)
|
|
(status-render status-win))
|
|
((eql ch #\1)
|
|
(config-render config-win)
|
|
(add-string config-win 3 1 "Providers: check daemon log for status.")
|
|
(refresh config-win))
|
|
((eql ch #\2)
|
|
(config-render config-win)
|
|
(add-string config-win 3 1 (format nil "Cascade: ~a" *provider-cascade*))
|
|
(refresh config-win))
|
|
((eql ch #\3)
|
|
(config-render config-win)
|
|
(add-string config-win 3 1 "Models: see recommendations per slot.")
|
|
(refresh config-win))
|
|
((eql ch #\4)
|
|
(config-render config-win)
|
|
(add-string config-win 3 1 (format nil "Active providers: ~a"
|
|
(loop for k being the hash-keys of *probabilistic-backends* collect k)))
|
|
(refresh config-win))))
|
|
(status-render status-win))
|
|
;; Chat mode key handling
|
|
(t
|
|
(cond
|
|
;; Enter/Return submit
|
|
((or (eql ch 10) (eql ch 13) (eq ch :enter) (eql ch #\Newline) (eql ch #\Return))
|
|
(setf *chat-scroll-pos* 0)
|
|
(input-submit *stream*)
|
|
(chat-render chat-win chat-h)
|
|
(input-render input-win)
|
|
(status-render status-win))
|
|
;; Backspace
|
|
((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
|
|
(input-backspace)
|
|
(input-render input-win))
|
|
;; Up arrow
|
|
((or (eq ch :up) (eql ch 259))
|
|
(let ((prev (input-history-nav :up)))
|
|
(when prev
|
|
(setf *input-buffer* (reverse (coerce prev 'list)))
|
|
(input-render input-win))))
|
|
;; Down arrow
|
|
((or (eq ch :down) (eql ch 258))
|
|
(let ((next (input-history-nav :down)))
|
|
(if next
|
|
(setf *input-buffer* (reverse (coerce next 'list)))
|
|
(setf *input-buffer* nil))
|
|
(input-render input-win)))
|
|
;; Page Up
|
|
((or (eq ch :ppage) (eql ch 339))
|
|
(setf *chat-scroll-pos* (+ *chat-scroll-pos* 10))
|
|
(chat-render chat-win chat-h)
|
|
(status-render status-win))
|
|
;; Page Down
|
|
((or (eq ch :npage) (eql ch 338))
|
|
(setf *chat-scroll-pos* (max 0 (- *chat-scroll-pos* 10)))
|
|
(chat-render chat-win chat-h)
|
|
(status-render status-win))
|
|
;; Printable character
|
|
((characterp ch)
|
|
(push ch *input-buffer*)
|
|
(input-render input-win))
|
|
;; Integer key code
|
|
((integerp ch)
|
|
(let ((converted (code-char ch)))
|
|
(when (and converted (graphic-char-p converted))
|
|
(push converted *input-buffer*)
|
|
(input-render input-win))))))))
|
|
(refresh scr)
|
|
(sleep 0.01))
|
|
(disconnect-daemon))))
|