fix(tui): correct unknown event type specifier

2026-04-27 19:05:57 -04:00
parent 2e8e79a193
commit 43986fda9c
1 changed files with 48 additions and 81 deletions
--- a/harness/tui-client.org
+++ b/harness/tui-client.org
@@ -27,7 +27,6 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
 (defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t))
 (defvar *command-history* (make-array 0 :element-type 't :fill-pointer 0 :adjustable t))
 (defvar *history-index* -1)
-(defvar *input-mode* :single)  ; :single or :multi
 (defvar *is-running* t)
 (defvar *queue-lock* (bt:make-lock))
 (defvar *incoming-msgs* nil)
@@ -39,29 +38,24 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
 (defun add-to-history (cmd)
  "Add command to history, preserving most recent."
  (when (and cmd (> (length cmd) 0))
-    ;; Don't duplicate the last command
    (unless (and (> (length *command-history*) 0)
-                  (string= cmd (aref *command-history* (1- (length *command-history*))))))
+                  (string= cmd (aref *command-history* (1- (length *command-history*)))))
      (vector-push-extend cmd *command-history* :adjustable t))
    (setf *history-index* (length *command-history*))))

 (defun history-previous ()
-  "Navigate to previous command in history."
  (when (> (length *command-history*) 0)
    (setf *history-index* (max 0 (1- *history-index*)))
    (let ((cmd (aref *command-history* *history-index*)))
      (setf (fill-pointer *input-buffer*) 0)
-      (loop for ch across cmd do (vector-push-extend ch *input-buffer*))
-      cmd)))
+      (loop for ch across cmd do (vector-push-extend ch *input-buffer*)))))

 (defun history-next ()
-  "Navigate to next command in history."
  (when (and *history-index* (< *history-index* (1- (length *command-history*))))
    (setf *history-index* (1+ *history-index*))
    (let ((cmd (aref *command-history* *history-index*)))
      (setf (fill-pointer *input-buffer*) 0)
-      (loop for ch across cmd do (vector-push-extend ch *input-buffer*))
-      cmd))
+      (loop for ch across cmd do (vector-push-extend ch *input-buffer*))))
  (when (>= *history-index* (1- (length *command-history*)))
    (setf (fill-pointer *input-buffer*) 0)))

@@ -81,7 +75,6 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
      msg))

 (defun format-payload (payload)
-  "Extracts human-readable text from a protocol payload, handling nested tool calls."
  (let* ((action (getf payload :ACTION))
         (text (getf payload :TEXT))
         (msg (getf payload :MESSAGE))
@@ -102,13 +95,12 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
          (t (format nil "~s" payload)))))

 (defun format-incoming (msg)
-  "Formats incoming message with styling."
  (let ((type (or (getf msg :TYPE) (getf msg :type)))
        (payload (or (getf msg :PAYLOAD) (getf msg :payload))))
    (cond
      ((and (listp msg) (eq type :EVENT))
       (let ((action (or (getf payload :ACTION) (getf payload :action)))
-             (text (or (getf payload :TEXT) (getf payload :text) (getf payload :MESSAGE) (getf payload :message)))))
+             (text (or (getf payload :TEXT) (getf payload :text) (getf payload :MESSAGE) (getf payload :message))))
         (cond ((eq action :handshake) (format nil "👋 ~a" (or text "Connected")))
               ((eq action :thinking) (format nil "🤔 ~a" (or text "Thinking...")))
               ((eq action :tool-complete) (format nil "🔧 Done"))
@@ -116,98 +108,81 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
               (t (format nil "📢 ~s" msg)))))
      ((and (listp msg) (eq type :STATUS))
       (format nil "🔄 Scribe: ~a | Gardener: ~a" 
-               (or (getf msg :SCRIBE) "idle")
-               (or (getf msg :GARDENER) "idle")))
+               (or (getf msg :SCRIBE) (getf msg :scribe) "idle")
+               (or (getf msg :GARDENER) (getf msg :gardener) "idle")))
      ((and (listp msg) (member type '(:REQUEST :RESPONSE :LOG)))
       (format-payload payload))
      ((and (listp msg) (eq type :EVENT) (eq (getf payload :SENSOR) :TOOL-OUTPUT))
       (format nil "🔧 ~a" (getf payload :RESULT)))
-      (t (format nil "~s" msg))))
+      (t (format nil "~s" msg)))))

 (defun listen-thread ()
-  (loop while *is-running* do
+  (loop :while *is-running* :do
    (handler-case
        (when (and *stream* (open-stream-p *stream*))
          (let ((raw-msg (opencortex:read-framed-message *stream*)))
-            (unless (member raw-msg '(:eof :error))
-              (let* ((msg (clean-keywords raw-msg))
-                     (type (or (getf msg :TYPE) (getf msg :type)))
-                     (payload (or (getf msg :PAYLOAD) (getf msg :payload))))
-                (cond ((and (listp msg) (eq type :EVENT))
-                       (let ((action (or (getf payload :ACTION) (getf payload :action)))
-                             (text (or (getf payload :TEXT) (getf payload :text) (getf payload :MESSAGE) (getf payload :message))))
-                         (cond ((eq action :handshake) (setf *status-text* "Ready"))
-                               (text (enqueue-msg (format nil "SYSTEM: ~a" text))))))
-                      ((and (listp msg) (eq type :STATUS))
-                       (setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]" 
-                                                   (or (getf msg :SCRIBE) (getf msg :scribe))
-                                                   (or (getf msg :GARDENER) (getf msg :gardener)))))
-                      ((and (listp msg) (member type '(:REQUEST :RESPONSE :LOG)))
-                       (let ((formatted (format-payload payload)))
-                         (when formatted (enqueue-msg formatted))))
-                      ((and (listp msg) (eq type :EVENT) (eq (getf payload :SENSOR) :TOOL-OUTPUT))
-                       (let ((formatted (format-payload payload)))
-                         (when formatted (enqueue-msg formatted))))
-                      (t (harness-log "TUI: Ignored unknown type ~a" type)))))
-            (when (eq raw-msg :eof) (setf *is-running* nil))
-            (when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
+            (cond ((eq raw-msg :eof) (setf *is-running* nil))
+                  ((eq raw-msg :error) (setf *status-text* "Protocol Error"))
+                  ((not (null raw-msg))
+                   (let* ((msg (clean-keywords raw-msg))
+                          (type (getf msg :TYPE))
+                          (payload (getf msg :PAYLOAD)))
+                     (cond ((and (eq type :EVENT) (eq (getf payload :ACTION) :handshake))
+                            (setf *status-text* "Ready"))
+                           ((eq type :STATUS)
+                            (setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]" 
+                                                        (or (getf msg :SCRIBE) "idle")
+                                                        (or (getf msg :GARDENER) "idle"))))
+                           (t (let ((formatted (format-incoming msg)))
+                                (when formatted (enqueue-msg formatted))))))))))
      (error (c) (setf *status-text* (format nil "Net Error: ~a" c)) (setf *is-running* nil)))
    (sleep 0.05)))

 (defun main ()
  (handler-case
      (setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
-    (error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
+    (error (e) (format t "Error connecting to Brain (port ~a): ~a~%" *daemon-port* e) (return-from main)))
  (setf *stream* (usocket:socket-stream *socket*))
  (bt:make-thread #'listen-thread :name "tui-listener")
  
  (unwind-protect
-      (with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t :window-border-chars #\┌#\─#\┐#\│#\└#\┘#\─#\│)
+      (with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t)
        (let* ((h (height scr))
               (w (width scr))
-               (chat-height (- h 5))
-               (chat-win (make-instance 'window :height chat-height :width (- w 2) :position (list 1 1) :border t))
+               (chat-win (make-instance 'window :height (- h 5) :width (- w 2) :position (list 1 1) :border t))
               (status-win (make-instance 'window :height 1 :width (- w 2) :position (list (- h 4) 1) :border t))
               (help-win (make-instance 'window :height 1 :width (- w 2) :position (list (- h 3) 1)))
               (input-win (make-instance 'window :height 1 :width (- w 2) :position (list (- h 2) 1) :border t))
               (last-status nil))
           
-           ;; Draw help once
-           (add-string help-win "↑↓ History | Esc Clear | /help /exit | Multi-line: Shift+Enter" :y 0 :x 0 :attributes '(:bold))
+           (add-string help-win "↑↓ History | Esc Clear | /help /exit" :y 0 :x 0 :attributes '(:bold))
           (refresh help-win)
-           
-           (setf (function-keys-enabled-p input-win) t)
           (setf (input-blocking input-win) nil)

-           (loop while *is-running* do
+           (loop :while *is-running* :do
             ;; 1. Handle incoming messages
             (let ((new-msgs (dequeue-msgs)))
               (when new-msgs
-                 (dolist (msg new-msgs)
-                   (let ((formatted (format-incoming msg)))
-                     (when formatted 
-                       (push formatted *chat-history*)
-                       (setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))))
-                 
+                 (dolist (m new-msgs)
+                   (push m *chat-history*)
+                   (when (> (length *chat-history*) 500) (setf *chat-history* (subseq *chat-history* 0 500))))
                 (clear chat-win)
                 (let ((line-num 1))
-                   (dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- chat-height 3)))))
+                   (dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- (height chat-win) 2)))))
                     (add-string chat-win (format nil "│ ~a" m) :y line-num :x 1)
                     (incf line-num)))
-                 ;; Add border line count
-                 (add-string chat-win (format nil "├─ ~d messages" (length *chat-history*)) :y (1- chat-height) :x 1 :attributes '(:dim))
                 (refresh chat-win)))

-             ;; 2. Render Status Bar ONLY if changed
+             ;; 2. Render Status Bar
             (unless (equal *status-text* last-status)
               (clear status-win)
               (add-string status-win (format nil "┤ ~a ┤" *status-text*) :y 0 :x 1 :attributes '(:reverse))
               (refresh status-win)
               (setf last-status *status-text*))

-              ;; 3. Handle Keyboard Input
-              (let* ((event (get-wide-event input-win))
-                     (ch (and event (typep event 'event) (event-key event))))
+              ;; 3. Keyboard Input
+              (let* ((event (get-event input-win))
+                     (ch (when (and event (typep event 'event)) (event-key event))))
                (when ch
                  (cond
                    ((or (eq ch #\Newline) (eq ch #\Return))
@@ -216,35 +191,27 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
                       (when (> (length cmd) 0)
                         (add-to-history cmd)
                         (enqueue-msg (format nil "⬆ ~a" cmd))
-                         (let ((framed (opencortex:frame-message (list :TYPE :EVENT 
-                                                                      :META (list :SOURCE :tui :SESSION-ID "default")
-                                                                      :PAYLOAD (list :SENSOR :user-input :TEXT cmd)))))
-                           (format *stream* "~a" framed)
-                           (finish-output *stream*)))
+                         (handler-case
+                             (when (and *stream* (open-stream-p *stream*))
+                               (format *stream* "~a" (opencortex:frame-message (list :TYPE :EVENT 
+                                                                                  :META (list :SOURCE :tui :SESSION-ID "default")
+                                                                                  :PAYLOAD (list :SENSOR :user-input :TEXT cmd))))
+                               (finish-output *stream*))
+                           (error (c) (enqueue-msg (format nil "ERROR SENDING: ~a" c)))))
                       (when (string= cmd "/exit") (setf *is-running* nil))
-                       (when (string= cmd "/clear") (setf *chat-history* nil))
-                       (when (string= cmd "/help") 
-                         (enqueue-msg "Available commands: /help /exit /clear /status")
-                         (enqueue-msg "Use ↑↓ for history, Esc to clear input"))))
-                    ((eq ch :up) (history-previous))
-                    ((eq ch :down) (history-next))
-                    ((eq ch :escape) 
-                     (setf (fill-pointer *input-buffer*) 0)
-                     (setf *history-index* (length *command-history*)))
-                    ((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout) (eq ch #\Del))
+                       (when (string= cmd "/clear") (setf *chat-history* nil))))
+                    ((or (eq ch :up) (eq ch :key-up)) (history-previous))
+                    ((or (eq ch :down) (eq ch :key-down)) (history-next))
+                    ((or (eq ch :backspace) (eq ch :key-backspace) (eq ch #\Backspace) (eq ch #\Rubout) (eq ch (code-char 127)))
                     (when (> (fill-pointer *input-buffer*) 0)
                       (decf (fill-pointer *input-buffer*))))
-                    ((eq ch :shift-left)  ; Shift+Enter for multi-line
-                     (vector-push-extend #\Newline *input-buffer*))
                    ((characterp ch)
                     (vector-push-extend ch *input-buffer*))))
                
                (clear input-win)
-                (let ((prompt (if (> (fill-pointer *input-buffer*) 0) "│" "▶")))
-                  (add-string input-win (format nil "~a ~a" prompt (coerce *input-buffer* 'string)) :y 0 :x 1 :attributes (when (> (fill-pointer *input-buffer*) 0) '(:bold))))
+                (add-string input-win (format nil "▶ ~a" (coerce *input-buffer* 'string)) :y 0 :x 1)
                (refresh input-win))
-             
             (sleep 0.02))))
    (setf *is-running* nil)
-    (when *socket* (usocket:socket-close *socket*))))
+    (when *socket* (ignore-errors (usocket:socket-close *socket*)))))
 #+end_src