fix: setup to org/lisp dirs, TUI protocol, deploy test
- Rewrite setup_system: deploy to org/ and lisp/ instead of harness/ and skills/ - Rewrite doctor_repair: same paths - TUI: add fallback for tui subcommand (matching daemon) - Fix send-message: use ~s instead of (~a) to avoid double-wrapping - Fix input-submit: send proper (:type :event :payload ...) plist format - Remove :timeout arg from get-char (croatoan doesn't support it) - Remove debug log-message from event loop (was noisy) - Verify: TUI runs from XDG deploy, sends messages, daemon processes
This commit is contained in:
@@ -16,12 +16,12 @@
|
|||||||
|
|
||||||
(defun send-message (stream msg)
|
(defun send-message (stream msg)
|
||||||
"Send a framed s-expression over TCP."
|
"Send a framed s-expression over TCP."
|
||||||
(let* ((sexp (format nil "(~a)" msg))
|
(let* ((sexp (format nil "~s" msg))
|
||||||
(len (length sexp))
|
(len (length sexp))
|
||||||
(header (format nil "~6,'0x" len)))
|
(header (format nil "~6,'0x" len)))
|
||||||
(write-sequence (babel:string-to-octets (concatenate 'string header sexp)) stream)
|
(write-sequence (babel:string-to-octets (concatenate 'string header sexp)) stream)
|
||||||
(force-output stream)
|
(force-output stream)))
|
||||||
(log-message "SENT: ~a" sexp)))
|
|
||||||
|
|
||||||
(defun read-message (stream)
|
(defun read-message (stream)
|
||||||
"Read a framed s-expression from TCP."
|
"Read a framed s-expression from TCP."
|
||||||
@@ -74,7 +74,7 @@
|
|||||||
(when (> (length text) 0)
|
(when (> (length text) 0)
|
||||||
(push text *input-history*)
|
(push text *input-history*)
|
||||||
(setf *input-history-pos* 0)
|
(setf *input-history-pos* 0)
|
||||||
(send-message stream text)
|
(send-message stream (list :type :event :payload (list :sensor :user-input :text text)))
|
||||||
(push (cons :sent text) *chat-history*)
|
(push (cons :sent text) *chat-history*)
|
||||||
(setf *input-buffer* nil))))
|
(setf *input-buffer* nil))))
|
||||||
|
|
||||||
@@ -280,7 +280,7 @@
|
|||||||
(or (proto-get p :text) (format nil "~a" msg))))
|
(or (proto-get p :text) (format nil "~a" msg))))
|
||||||
*chat-history*))
|
*chat-history*))
|
||||||
;; handle input
|
;; handle input
|
||||||
(let ((ch (get-char input-win :timeout 0.1)))
|
(let ((ch (get-char input-win)))
|
||||||
(when (and ch (not (equal ch -1)))
|
(when (and ch (not (equal ch -1)))
|
||||||
(log-message "KEY: ~s type=~s" ch (type-of ch))
|
(log-message "KEY: ~s type=~s" ch (type-of ch))
|
||||||
(cond
|
(cond
|
||||||
|
|||||||
@@ -44,12 +44,12 @@ The TUI Client is a Croatoan-based ncurses chat interface for Passepartout. It c
|
|||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun send-message (stream msg)
|
(defun send-message (stream msg)
|
||||||
"Send a framed s-expression over TCP."
|
"Send a framed s-expression over TCP."
|
||||||
(let* ((sexp (format nil "(~a)" msg))
|
(let* ((sexp (format nil "~s" msg))
|
||||||
(len (length sexp))
|
(len (length sexp))
|
||||||
(header (format nil "~6,'0x" len)))
|
(header (format nil "~6,'0x" len)))
|
||||||
(write-sequence (babel:string-to-octets (concatenate 'string header sexp)) stream)
|
(write-sequence (babel:string-to-octets (concatenate 'string header sexp)) stream)
|
||||||
(force-output stream)
|
(force-output stream)))
|
||||||
(log-message "SENT: ~a" sexp)))
|
|
||||||
|
|
||||||
(defun read-message (stream)
|
(defun read-message (stream)
|
||||||
"Read a framed s-expression from TCP."
|
"Read a framed s-expression from TCP."
|
||||||
@@ -108,7 +108,7 @@ The TUI Client is a Croatoan-based ncurses chat interface for Passepartout. It c
|
|||||||
(when (> (length text) 0)
|
(when (> (length text) 0)
|
||||||
(push text *input-history*)
|
(push text *input-history*)
|
||||||
(setf *input-history-pos* 0)
|
(setf *input-history-pos* 0)
|
||||||
(send-message stream text)
|
(send-message stream (list :type :event :payload (list :sensor :user-input :text text)))
|
||||||
(push (cons :sent text) *chat-history*)
|
(push (cons :sent text) *chat-history*)
|
||||||
(setf *input-buffer* nil))))
|
(setf *input-buffer* nil))))
|
||||||
|
|
||||||
@@ -326,7 +326,7 @@ The TUI Client is a Croatoan-based ncurses chat interface for Passepartout. It c
|
|||||||
(or (proto-get p :text) (format nil "~a" msg))))
|
(or (proto-get p :text) (format nil "~a" msg))))
|
||||||
*chat-history*))
|
*chat-history*))
|
||||||
;; handle input
|
;; handle input
|
||||||
(let ((ch (get-char input-win :timeout 0.1)))
|
(let ((ch (get-char input-win)))
|
||||||
(when (and ch (not (equal ch -1)))
|
(when (and ch (not (equal ch -1)))
|
||||||
(log-message "KEY: ~s type=~s" ch (type-of ch))
|
(log-message "KEY: ~s type=~s" ch (type-of ch))
|
||||||
(cond
|
(cond
|
||||||
|
|||||||
63
passepartout
63
passepartout
@@ -83,7 +83,7 @@ setup_system() {
|
|||||||
|
|
||||||
echo -e "${BLUE}=== Passepartout: Configure ===${NC}"
|
echo -e "${BLUE}=== Passepartout: Configure ===${NC}"
|
||||||
mkdir -p "$PASSEPARTOUT_CONFIG_DIR" "$PASSEPARTOUT_DATA_DIR" "$PASSEPARTOUT_STATE_DIR" "$PASSEPARTOUT_BIN_DIR"
|
mkdir -p "$PASSEPARTOUT_CONFIG_DIR" "$PASSEPARTOUT_DATA_DIR" "$PASSEPARTOUT_STATE_DIR" "$PASSEPARTOUT_BIN_DIR"
|
||||||
mkdir -p "$PASSEPARTOUT_DATA_DIR/harness" "$PASSEPARTOUT_DATA_DIR/tests" "$PASSEPARTOUT_DATA_DIR/skills"
|
mkdir -p "$PASSEPARTOUT_DATA_DIR/org" "$PASSEPARTOUT_DATA_DIR/lisp" "$PASSEPARTOUT_DATA_DIR/tests"
|
||||||
|
|
||||||
check_dependencies
|
check_dependencies
|
||||||
|
|
||||||
@@ -98,39 +98,22 @@ setup_system() {
|
|||||||
|
|
||||||
echo -e "${YELLOW}--- Deploying Engine to $PASSEPARTOUT_DATA_DIR ---${NC}"
|
echo -e "${YELLOW}--- Deploying Engine to $PASSEPARTOUT_DATA_DIR ---${NC}"
|
||||||
cp "$SCRIPT_DIR/passepartout.asd" "$PASSEPARTOUT_DATA_DIR/"
|
cp "$SCRIPT_DIR/passepartout.asd" "$PASSEPARTOUT_DATA_DIR/"
|
||||||
mkdir -p "$PASSEPARTOUT_DATA_DIR/harness" "$PASSEPARTOUT_DATA_DIR/tests" "$PASSEPARTOUT_DATA_DIR/skills"
|
mkdir -p "$PASSEPARTOUT_DATA_DIR/org" "$PASSEPARTOUT_DATA_DIR/lisp" "$PASSEPARTOUT_DATA_DIR/tests"
|
||||||
export INSTALL_DIR="$PASSEPARTOUT_DATA_DIR"
|
export INSTALL_DIR="$PASSEPARTOUT_DATA_DIR"
|
||||||
|
|
||||||
cp "$SCRIPT_DIR/org"/*.org "$PASSEPARTOUT_DATA_DIR/harness/"
|
# Tangle all org files into lisp/
|
||||||
(cd "$PASSEPARTOUT_DATA_DIR/harness" && emacs -Q --batch \
|
|
||||||
--eval "(require 'org)" \
|
|
||||||
--eval "(setq org-confirm-babel-evaluate nil)" \
|
|
||||||
--eval "(org-babel-tangle-file \"manifest.org\")") >/dev/null 2>&1 || true
|
|
||||||
for f in "$PASSEPARTOUT_DATA_DIR/harness"/*.org; do
|
|
||||||
fname=$(basename "$f" .org)
|
|
||||||
[ "$fname" = "manifest" ] && continue
|
|
||||||
echo "Tangling harness/$fname.org..."
|
|
||||||
(cd "$PASSEPARTOUT_DATA_DIR/harness" && emacs -Q --batch \
|
|
||||||
--eval "(require 'org)" \
|
|
||||||
--eval "(setq org-confirm-babel-evaluate nil)" \
|
|
||||||
--eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true
|
|
||||||
done
|
|
||||||
find "$PASSEPARTOUT_DATA_DIR/harness" -name "*-tests.lisp" -exec mv {} "$PASSEPARTOUT_DATA_DIR/tests/" \; 2>/dev/null || true
|
|
||||||
rm -f "$PASSEPARTOUT_DATA_DIR/harness"/*.org
|
|
||||||
|
|
||||||
for f in "$SCRIPT_DIR/org"/*.org; do
|
for f in "$SCRIPT_DIR/org"/*.org; do
|
||||||
|
[ -f "$f" ] || continue
|
||||||
fname=$(basename "$f" .org)
|
fname=$(basename "$f" .org)
|
||||||
echo "Tangling skills/$fname.org..."
|
echo "Tangling $fname..."
|
||||||
cp "$f" "$PASSEPARTOUT_DATA_DIR/skills/"
|
cp "$f" "$PASSEPARTOUT_DATA_DIR/org/"
|
||||||
(cd "$PASSEPARTOUT_DATA_DIR/skills" && emacs -Q --batch \
|
(cd "$PASSEPARTOUT_DATA_DIR/org" && emacs -Q --batch \
|
||||||
--eval "(require 'org)" \
|
--eval "(require 'org)" \
|
||||||
--eval "(setq org-confirm-babel-evaluate nil)" \
|
--eval "(setq org-confirm-babel-evaluate nil)" \
|
||||||
--eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true
|
--eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true
|
||||||
rm -f "$PASSEPARTOUT_DATA_DIR/skills/$fname.org"
|
|
||||||
done
|
done
|
||||||
find "$PASSEPARTOUT_DATA_DIR/skills" -name "*-tests.lisp" -exec mv {} "$PASSEPARTOUT_DATA_DIR/tests/" \; 2>/dev/null || true
|
# Move test files to tests/ directory
|
||||||
[ -f "$PASSEPARTOUT_DATA_DIR/run-all-tests.lisp" ] && mv "$PASSEPARTOUT_DATA_DIR/run-all-tests.lisp" "$PASSEPARTOUT_DATA_DIR/harness/"
|
find "$PASSEPARTOUT_DATA_DIR/lisp" -name "*-tests.lisp" -exec mv {} "$PASSEPARTOUT_DATA_DIR/tests/" \; 2>/dev/null || true
|
||||||
rm -f "$PASSEPARTOUT_DATA_DIR/harness"/*.org "$PASSEPARTOUT_DATA_DIR/skills"/*.org
|
|
||||||
|
|
||||||
ln -sf "$SCRIPT_DIR/passepartout.sh" "$PASSEPARTOUT_BIN_DIR/passepartout"
|
ln -sf "$SCRIPT_DIR/passepartout.sh" "$PASSEPARTOUT_BIN_DIR/passepartout"
|
||||||
|
|
||||||
@@ -160,38 +143,23 @@ doctor_repair() {
|
|||||||
echo -e "${BLUE}=== Passepartout: Repair Mode ===${NC}"
|
echo -e "${BLUE}=== Passepartout: Repair Mode ===${NC}"
|
||||||
check_dependencies
|
check_dependencies
|
||||||
mkdir -p "$PASSEPARTOUT_CONFIG_DIR" "$PASSEPARTOUT_DATA_DIR" "$PASSEPARTOUT_STATE_DIR" "$PASSEPARTOUT_BIN_DIR"
|
mkdir -p "$PASSEPARTOUT_CONFIG_DIR" "$PASSEPARTOUT_DATA_DIR" "$PASSEPARTOUT_STATE_DIR" "$PASSEPARTOUT_BIN_DIR"
|
||||||
mkdir -p "$PASSEPARTOUT_DATA_DIR/harness" "$PASSEPARTOUT_DATA_DIR/tests" "$PASSEPARTOUT_DATA_DIR/skills"
|
mkdir -p "$PASSEPARTOUT_DATA_DIR/org" "$PASSEPARTOUT_DATA_DIR/lisp" "$PASSEPARTOUT_DATA_DIR/tests"
|
||||||
for f in "$SCRIPT_DIR/org"/*.org; do
|
for f in "$SCRIPT_DIR/org"/*.org; do
|
||||||
[ -f "$f" ] || continue
|
[ -f "$f" ] || continue
|
||||||
fname=$(basename "$f" .org)
|
fname=$(basename "$f" .org)
|
||||||
echo " Checking harness/$fname..."
|
echo " Checking $fname..."
|
||||||
if ! sbcl --non-interactive \
|
if ! sbcl --non-interactive \
|
||||||
--eval "(load \"$PASSEPARTOUT_DATA_DIR/harness/${fname}.lisp\")" \
|
--eval "(load \"$PASSEPARTOUT_DATA_DIR/lisp/${fname}.lisp\")" \
|
||||||
--eval "(format t \"OK~%\")" 2>/dev/null | grep -q "OK"; then
|
--eval "(format t \"OK~%\")" 2>/dev/null | grep -q "OK"; then
|
||||||
echo " Re-tangling $fname.org..."
|
echo " Re-tangling $fname.org..."
|
||||||
(cd "$PASSEPARTOUT_DATA_DIR/harness" && emacs -Q --batch \
|
cp "$f" "$PASSEPARTOUT_DATA_DIR/org/"
|
||||||
--eval "(require 'org)" \
|
(cd "$PASSEPARTOUT_DATA_DIR/org" && emacs -Q --batch \
|
||||||
--eval "(setq org-confirm-babel-evaluate nil)" \
|
|
||||||
--eval "(org-babel-tangle-file \"$f\")") >/dev/null 2>&1 || true
|
|
||||||
fi
|
|
||||||
done
|
|
||||||
for f in "$SCRIPT_DIR/org"/*.org; do
|
|
||||||
[ -f "$f" ] || continue
|
|
||||||
fname=$(basename "$f" .org)
|
|
||||||
echo " Checking skill/$fname..."
|
|
||||||
if ! sbcl --non-interactive \
|
|
||||||
--eval "(load \"$PASSEPARTOUT_DATA_DIR/skills/${fname}.lisp\")" \
|
|
||||||
--eval "(format t \"OK~%\")" 2>/dev/null | grep -q "OK"; then
|
|
||||||
echo " Re-tangling $fname.org..."
|
|
||||||
cp "$f" "$PASSEPARTOUT_DATA_DIR/skills/"
|
|
||||||
(cd "$PASSEPARTOUT_DATA_DIR/skills" && emacs -Q --batch \
|
|
||||||
--eval "(require 'org)" \
|
--eval "(require 'org)" \
|
||||||
--eval "(setq org-confirm-babel-evaluate nil)" \
|
--eval "(setq org-confirm-babel-evaluate nil)" \
|
||||||
--eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true
|
--eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true
|
||||||
rm -f "$PASSEPARTOUT_DATA_DIR/skills/$fname.org"
|
|
||||||
fi
|
fi
|
||||||
done
|
done
|
||||||
rm -f "$PASSEPARTOUT_DATA_DIR/harness"/*.org "$PASSEPARTOUT_DATA_DIR/skills"/*.org 2>/dev/null || true
|
find "$PASSEPARTOUT_DATA_DIR/lisp" -name "*-tests.lisp" -exec mv {} "$PASSEPARTOUT_DATA_DIR/tests/" \; 2>/dev/null || true
|
||||||
echo -e "${GREEN}--- Repair Complete ---${NC}"
|
echo -e "${GREEN}--- Repair Complete ---${NC}"
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -397,6 +365,7 @@ case "$COMMAND" in
|
|||||||
;;
|
;;
|
||||||
tui)
|
tui)
|
||||||
check_dependencies
|
check_dependencies
|
||||||
|
export PASSEPARTOUT_DATA_DIR="${PASSEPARTOUT_DATA_DIR:-$SCRIPT_DIR}"
|
||||||
if ! ss -tln 2>/dev/null | grep -q 9105 && ! netstat -tln 2>/dev/null | grep -q 9105; then
|
if ! ss -tln 2>/dev/null | grep -q 9105 && ! netstat -tln 2>/dev/null | grep -q 9105; then
|
||||||
echo "Starting daemon first..."
|
echo "Starting daemon first..."
|
||||||
$0 daemon
|
$0 daemon
|
||||||
|
|||||||
Reference in New Issue
Block a user