diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index 3bf2e4c..ed8ba56 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -758,6 +758,55 @@ supplied (e.g. \"/\"), pre-fill the select filter with it." ** Connection #+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-main.lisp +;; Process a key-event: route through dialog, keymap, navigation, or text-input. +(defun process-key-event (event) + (let* ((k (cl-tty.input:key-event-key event))) + (cond + ((st :dialog-stack) + (let* ((dlg (car (st :dialog-stack))) + (sel (cl-tty.dialog:dialog-content dlg))) + (cond + ((eq k :escape) + (pop (st :dialog-stack)) + (setf (st :dirty) (list t t nil))) + ((member k '(:up :down)) + (if (eq k :up) + (cl-tty.dialog:select-prev sel) + (cl-tty.dialog:select-next sel)) + (setf (st :dirty) (list t t nil))) + ((eq k :enter) + (let* ((filtered (cl-tty.dialog:select-filtered-options sel)) + (idx (cl-tty.dialog:select-selected-index sel)) + (item (when (< idx (length filtered)) + (third (nth idx filtered))))) + (when item + (let ((cb (cl-tty.dialog:select-on-select sel))) + (when cb (funcall cb item)))) + (pop (st :dialog-stack)) + (setf (st :dirty) (list t t nil)))) + ((let ((ch (code-char (cl-tty.input:key-event-code event)))) + (and ch (graphic-char-p ch)) + (setf (cl-tty.dialog:select-filter sel) + (concatenate 'string + (or (cl-tty.dialog:select-filter sel) "") + (string ch))))) + ((eq k :backspace) + (let* ((f (cl-tty.dialog:select-filter sel)) + (len (length (or f "")))) + (when (> len 0) + (setf (cl-tty.dialog:select-filter sel) + (subseq f 0 (1- len))))))))) + ((cl-tty.input:dispatch-key-event event) + (setf (st :dirty) (list t t nil))) + ((member k '(:enter :tab :escape :up :down)) + (on-key k)) + (t (handler-case + (progn + (cl-tty.input:handle-text-input (st :text-input) event) + (setf (st :dirty) (list nil nil t))) + (error (c) + (add-msg :system (format nil "* Input error: ~a *" c)))))))) + (defun connect-daemon (&optional (host "127.0.0.1") (start-port 9105) (end-port 9115)) "Try to connect to daemon once across START-PORT to END-PORT. Returns T on success, nil on failure. Does NOT wait or retry." @@ -919,8 +968,11 @@ Returns T on success, nil on failure. Does NOT wait or retry." (loop while (and (st :running) (not (st :connected))) do (connect-daemon) (unless (st :connected) (sleep 5)))) - :name "daemon-auto-connect")) - (loop while (st :running) do + :name "daemon-auto-connect")) + ;; Initial render before first read-event (which may block) + (unless (st :dialog-stack) + (redraw be w h)) + (loop while (st :running) do (dolist (ev (drain-queue)) (cond ((eq (getf ev :type) :daemon) @@ -982,25 +1034,8 @@ Returns T on success, nil on failure. Does NOT wait or retry." (let ((new-size resize-data)) (setq w (car new-size) h (cdr new-size)) (setf (st :dirty) (list t t t)))) - ((cl-tty.input:key-event-p ev) - (let* ((k (cl-tty.input:key-event-key ev)) - (ctrl (cl-tty.input:key-event-ctrl ev)) - (code (cl-tty.input:key-event-code ev)) - (ch (cond - ;; Ctrl+letter → :CTRL-X keyword (compatible with case dispatch) - (ctrl (let ((c (char (symbol-name k) 0))) - (intern (string-upcase (format nil "CTRL-~a" c)) :keyword))) - ;; PageUp/PageDown → :ppage/:npage - ((eq k :page-up) :ppage) - ((eq k :page-down) :npage) - ;; Single-char keyword → printable character - ((and (keywordp k) (= (length (symbol-name k)) 1)) - (code-char code)) - ;; Everything else → pass keyword through - (t k)))) - (queue-event - (list :type :key - :payload (list :code (or code 0) :ch ch))))))) + ((cl-tty.input:key-event-p ev) + (process-key-event ev)))) (error (c) (add-msg :system (format nil "* Reader error: ~a *" c)))) ;; Guard w and h before render (resize or other code may have set them to nil) @@ -1062,12 +1097,9 @@ Returns T on success, nil on failure. Does NOT wait or retry." (cl-tty.backend:draw-text be 0 (- h 3) (format nil "> ~a" (or filter "")) (theme-color :input-prompt) bg-p)) - (cl-tty.backend:end-sync be)) - (sleep 0.1) - ;; Show terminal cursor at input position every frame - (unless (st :dialog-stack) - (passepartout.channel-tui:position-cursor be w h)))) - (progn (disconnect-daemon))))) + (cl-tty.backend:end-sync be)) + (sleep 0.1))) + (progn (disconnect-daemon))))) #+END_SRC * Test Suite diff --git a/org/channel-tui-state.org b/org/channel-tui-state.org index 8a2e436..9fef5b5 100644 --- a/org/channel-tui-state.org +++ b/org/channel-tui-state.org @@ -20,10 +20,9 @@ All state mutation flows through event handlers in the controller. #+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-state.lisp (defpackage :passepartout.channel-tui (:use :cl :passepartout :usocket :bordeaux-threads) - (:export :tui-main :st :add-msg :now :input-string + (:export :tui-main :st :add-msg :now :queue-event :drain-queue :init-state :view-status :view-chat :view-input :redraw - :position-cursor :input-panel-top :on-key :on-daemon-msg :send-daemon :connect-daemon :disconnect-daemon @@ -310,11 +309,10 @@ Adds any missing keys with defaults to handle saved themes from older versions." (defun init-state () (setf *state* (list :running t :mode :chat :connected nil :stream nil - :input-buffer nil :input-history nil :input-hpos 0 + :input-history nil :input-hpos 0 :text-input (cl-tty.input:make-text-input) :messages (make-array 16 :adjustable t :fill-pointer 0) - :scroll-offset 0 :busy nil :cursor-pos 0 - :cursor-line 0 :cursor-col 0 + :scroll-offset 0 :busy nil :pending-ctrl-x nil :scroll-at-bottom t :scroll-notify nil :streaming-text nil :url-buffer nil ; v0.7.1 @@ -342,15 +340,6 @@ Adds any missing keys with defaults to handle saved themes from older versions." (declare (ignore s)) (format nil "~2,'0d:~2,'0d" h m))) -(defun input-string () - (cl-tty.input:text-input-value (st :text-input))) - -(defun input-insert-char (ch) - (cl-tty.input:text-input-insert (st :text-input) ch)) - -(defun input-delete-char () - (cl-tty.input:text-input-backspace (st :text-input))) - (defun add-msg (role content &key gate-trace panel) (vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace :panel panel) (st :messages)) ;; v0.7.0: notify when scrolled up and new msg arrives diff --git a/org/channel-tui-view.org b/org/channel-tui-view.org index 6a37bf4..9543ec6 100644 --- a/org/channel-tui-view.org +++ b/org/channel-tui-view.org @@ -71,16 +71,16 @@ Returns a list of strings, one per line." ) (defun input-panel-top (chat-w h) - "Compute the top row of the input panel based on current input buffer." + "Compute the top row of the input panel based on current input text." (let* ((hpad 2) (inner-w (- chat-w (* 2 hpad))) (prompt-w (- inner-w 2)) - (text (input-string)) - (lines (word-wrap text prompt-w)) + (text (cl-tty.input:text-input-value (st :text-input))) + (lines (cl-tty.box:word-wrap text prompt-w)) (n-lines (max 1 (length lines))) (panel-rows (max 4 (+ n-lines 2)))) (- h 4 panel-rows -1))) - +#+end_src ;; Build simple tab-like blocks #+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp @@ -204,16 +204,17 @@ Returns a list of strings, one per line." (chat-w (- w sidebar-w)) (inner-w (- chat-w (* 2 hpad))) (prompt-w (- inner-w 2)) - (text (input-string)) - (pos (or (st :cursor-pos) 0)) - (lines (word-wrap text prompt-w)) + (input (st :text-input)) + (text (cl-tty.input:text-input-value input)) + (pos (cl-tty.input:text-input-cursor input)) + (lines (cl-tty.box:word-wrap text prompt-w)) (n-lines (max 1 (length lines))) (panel-rows (max 4 (+ n-lines 2))) (panel-top (input-panel-top chat-w h)) (bg-i (theme-color :bg-input)) (input-fg (theme-color :input-fg)) (hint-fg (theme-color :hint))) - ;; Fill input panel: panel-top to h-4, indented by hpad + ;; Fill input panel (cl-tty.backend:draw-rect fb hpad panel-top inner-w panel-rows :bg bg-i) ;; Speaker lines for all input rows (dotimes (r panel-rows) @@ -226,11 +227,15 @@ Returns a list of strings, one per line." (len (length line))) (when (>= row (- h 4)) (return)) (cl-tty.backend:draw-text fb (+ hpad 2) row line input-fg nil) - (when (and (>= pos accum) (<= pos (+ accum len))) + (when (and (>= pos accum) (or (< pos (+ accum len)) (= i (1- n-lines)))) (setf cursor-line i cursor-col (- pos accum))) (incf accum (1+ len)))) - ;; Hint bar at h-2: F:/MCP: on left, token gauge + keybindings on right + ;; Draw block cursor at insertion point + (let* ((cx (+ hpad 2 cursor-col)) + (cy (+ panel-top 1 cursor-line))) + (cl-tty.backend:draw-text fb cx cy "█" :bright-white nil))) + ;; Hint bar at h-2 (let* ((focal (or (st :foveal-id) "-")) (focal-str (format nil "F:~a" focal)) (mcp-str (format nil "MCP:~d" (or (st :mcp-count) 0))) @@ -251,7 +256,7 @@ Returns a list of strings, one per line." (ctx-x (- hint-x 1 (length ctx-str)))) (cl-tty.backend:draw-text fb hpad (- h 2) left-str hint-fg (theme-color :bg)) (cl-tty.backend:draw-text fb ctx-x (- h 2) ctx-str ctx-fg (theme-color :bg)) - (cl-tty.backend:draw-text fb hint-x (- h 2) hint-str hint-fg (theme-color :bg)))))) + (cl-tty.backend:draw-text fb hint-x (- h 2) hint-str hint-fg (theme-color :bg))))) #+end_src ** Sidebar @@ -331,39 +336,19 @@ Returns a list of strings, one per line." (setq w (or (and (numberp w) (> w 0) w) 80) h (or (and (numberp h) (> h 0) h) 24)) (when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty))) - (cl-tty.backend:begin-sync fb) - (cl-tty.backend:draw-rect fb 0 0 w h :bg (theme-color :bg)) - (view-status fb w h) - (view-chat fb w h) - (view-input fb w h) - (when (sidebar-visible-p w) - (view-sidebar fb w h)) - (cl-tty.backend:end-sync fb) - (setf (st :dirty) (list nil nil nil)))) + (handler-case + (progn + (cl-tty.backend:with-frame (fb) + (cl-tty.backend:draw-rect fb 0 0 w h :bg (theme-color :bg)) + (view-status fb w h) + (view-chat fb w h) + (view-input fb w h) + (when (sidebar-visible-p w) + (view-sidebar fb w h))) + (setf (st :dirty) (list nil nil nil))) + (error (c) + (add-msg :system (format nil "* Render error: ~a *" c)))))) -(defun position-cursor (fb w h) - "Draw cursor at the input insertion point using reverse video (Emacs-style). - - The character under the cursor is redrawn with foreground and background - swapped. If the cursor is past the end of the input string, a reversed - space is drawn." - (let* ((sw (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0)) - (cw (- w sw)) - (hpad 2) - (text (input-string)) - (text-len (length text)) - (pos (or (st :cursor-pos) 0)) - (prompt-w (- cw (* 2 hpad) 2)) - (display-start (max 0 (- pos (1- prompt-w)))) - (cx (+ hpad 2 (- pos display-start))) - (cy (- h 6)) - (bg-i (theme-color :bg-input)) - (input-fg (theme-color :input-fg))) - (if (< pos text-len) - (let ((ch (char text pos))) - (cl-tty.backend:draw-text fb cx cy (string ch) bg-i input-fg)) - (cl-tty.backend:draw-text fb cx cy " " bg-i input-fg)) - (finish-output (cl-tty.backend::backend-output-stream fb)))) #+END_SRC * Implementation — v0.7.0 additions diff --git a/passepartout b/passepartout index d0fb31d..23ec788 100755 --- a/passepartout +++ b/passepartout @@ -395,11 +395,10 @@ case "$COMMAND" in stty -icanon -echo -ixon 2>/dev/null || true # Ensure COLORTERM is set for modern backend detection export COLORTERM="${COLORTERM:-truecolor}" - # Clear stale cache - find ~/.cache/common-lisp -name "*.fasl" -path "*passepartout*" -o -name "*.fasl" -path "*cl-tty*" -delete 2>/dev/null sbcl --noinform \ --load "$HOME/quicklisp/setup.lisp" \ --eval '(push (truename "'"$PASSEPARTOUT_DATA_DIR"'/") asdf:*central-registry*)' \ + --eval '(setf *debugger-hook* nil uiop:*compile-file-failure-behaviour* :warn)' \ --eval '(ql:quickload :passepartout/tui)' \ --eval '(in-package :passepartout)' \ --eval '(passepartout.channel-tui:tui-main)'