diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index 5d3917d..a7b84a2 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -1,18 +1,9 @@ (in-package :passepartout.channel-tui) -(defun on-key (&rest args) - ;; Normalize: get-char returns raw ncurses integer codes (e.g. 263 for - ;; backspace). Croatoan's code-key + key-name convert them to keywords - ;; so the cond below can use eq. - (let* ((raw (car args)) - (ch (if (and (integerp raw) (> raw 255)) - (let* ((k (code-key raw)) - (name (and k (key-name k)))) - (or name raw)) - raw))) - (cond - ;; v0.7.1: Esc — interrupt streaming - ((and (eql ch 27) (st :streaming-text)) +(defun on-key (ch) + (cond + ;; v0.7.1: Esc — interrupt streaming + ((and (eq ch :escape) (st :streaming-text)) (send-daemon (list :type :event :payload '(:action :cancel-stream))) (when (> (length (st :messages)) 0) (let ((idx (1- (length (st :messages))))) @@ -535,17 +526,17 @@ (input-delete-char) (setf (st :dirty) (list nil nil t))) ;; Left arrow - ((or (eq ch :left) (eql ch 260)) + ((eq ch :left) (when (> (or (st :cursor-pos) 0) 0) (decf (st :cursor-pos)) (setf (st :dirty) (list nil nil t)))) ;; Right arrow - ((or (eq ch :right) (eql ch 261)) + ((eq ch :right) (when (< (or (st :cursor-pos) 0) (length (st :input-buffer))) (incf (st :cursor-pos)) (setf (st :dirty) (list nil nil t)))) ;; Up arrow - ((or (eq ch :up) (eql ch 259)) + ((eq ch :up) (let* ((h (st :input-history)) (p (st :input-hpos))) (when (and h (< p (1- (length h)))) (incf (st :input-hpos)) @@ -553,7 +544,7 @@ (reverse (coerce (nth (st :input-hpos) h) 'list))) (setf (st :dirty) (list nil nil t))))) ;; Down arrow - ((or (eq ch :down) (eql ch 258)) + ((eq ch :down) (when (> (st :input-hpos) 0) (decf (st :input-hpos)) (let ((h (st :input-history))) @@ -563,12 +554,12 @@ nil)) (setf (st :dirty) (list nil nil t))))) ;; PageUp — scroll back by page (10 lines) - ((or (eq ch :ppage) (eql ch 339)) + ((eq ch :ppage) (let ((max-offset (max 0 (- (length (st :messages)) 1)))) (setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10)))) (setf (st :dirty) (list nil t nil))) ;; PageDown — scroll forward by page - ((or (eq ch :npage) (eql ch 338)) + ((eq ch :npage) (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10))) (setf (st :dirty) (list nil t nil))) ;; Printable @@ -579,7 +570,7 @@ (t nil)))) (when (and chr (graphic-char-p chr)) (input-insert-char chr) - (setf (st :dirty) (list nil nil t)))))))) + (setf (st :dirty) (list nil nil t))))))) ;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny (defun resolve-hitl-panel (decision) @@ -801,7 +792,7 @@ (let ((prev-fb (cl-tty.rendering:make-framebuffer w h)) (curr-fb (cl-tty.rendering:make-framebuffer w h))) ;; Initial render - (redraw be curr-fb w h) + (redraw curr-fb w h) (cl-tty.rendering:flush-framebuffer prev-fb curr-fb be) (rotatef prev-fb curr-fb) (loop while (st :running) do @@ -850,7 +841,7 @@ (t (on-key ch))))))) (when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty))) (cl-tty.backend:backend-clear curr-fb) - (redraw be curr-fb w h) + (redraw curr-fb w h) (cl-tty.rendering:flush-framebuffer prev-fb curr-fb be) (rotatef prev-fb curr-fb)) (sleep 0.1)))) diff --git a/lisp/channel-tui-view.lisp b/lisp/channel-tui-view.lisp index e801e8a..1b86fab 100644 --- a/lisp/channel-tui-view.lisp +++ b/lisp/channel-tui-view.lisp @@ -1,11 +1,24 @@ (in-package :passepartout.channel-tui) +(defun word-wrap (text width) + "Wrap TEXT to at most WIDTH columns. Splits on word boundaries. +Returns a list of strings, one per line." + (let ((lines nil)) + (loop while (> (length text) width) + do (let ((break (or (position #\Space text :end width :from-end t) + width))) + (push (subseq text 0 break) lines) + (setf text (string-left-trim '(#\Space) + (subseq text break))))) + (push text lines) + (nreverse lines))) + (defun view-status (fb w) - (let ((degraded (and (find-package :passepartout) - (boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout)) - (member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout)) - '(:degraded :unhealthy)))) - (bg (if degraded :bright-yellow nil))) + (let* ((degraded (and (find-package :passepartout) + (boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout)) + (member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout)) + '(:degraded :unhealthy)))) + (bg (if degraded :bright-yellow nil))) ;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy (cl-tty.backend:draw-text fb 1 1 (format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a" diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index 20f6d5e..38e013e 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -34,19 +34,10 @@ Event handlers + daemon I/O + main loop. #+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp (in-package :passepartout.channel-tui) -(defun on-key (&rest args) - ;; Normalize: get-char returns raw ncurses integer codes (e.g. 263 for - ;; backspace). Croatoan's code-key + key-name convert them to keywords - ;; so the cond below can use eq. - (let* ((raw (car args)) - (ch (if (and (integerp raw) (> raw 255)) - (let* ((k (code-key raw)) - (name (and k (key-name k)))) - (or name raw)) - raw))) - (cond - ;; v0.7.1: Esc — interrupt streaming - ((and (eql ch 27) (st :streaming-text)) +(defun on-key (ch) + (cond + ;; v0.7.1: Esc — interrupt streaming + ((and (eq ch :escape) (st :streaming-text)) (send-daemon (list :type :event :payload '(:action :cancel-stream))) (when (> (length (st :messages)) 0) (let ((idx (1- (length (st :messages))))) @@ -569,17 +560,17 @@ Event handlers + daemon I/O + main loop. (input-delete-char) (setf (st :dirty) (list nil nil t))) ;; Left arrow - ((or (eq ch :left) (eql ch 260)) + ((eq ch :left) (when (> (or (st :cursor-pos) 0) 0) (decf (st :cursor-pos)) (setf (st :dirty) (list nil nil t)))) ;; Right arrow - ((or (eq ch :right) (eql ch 261)) + ((eq ch :right) (when (< (or (st :cursor-pos) 0) (length (st :input-buffer))) (incf (st :cursor-pos)) (setf (st :dirty) (list nil nil t)))) ;; Up arrow - ((or (eq ch :up) (eql ch 259)) + ((eq ch :up) (let* ((h (st :input-history)) (p (st :input-hpos))) (when (and h (< p (1- (length h)))) (incf (st :input-hpos)) @@ -587,7 +578,7 @@ Event handlers + daemon I/O + main loop. (reverse (coerce (nth (st :input-hpos) h) 'list))) (setf (st :dirty) (list nil nil t))))) ;; Down arrow - ((or (eq ch :down) (eql ch 258)) + ((eq ch :down) (when (> (st :input-hpos) 0) (decf (st :input-hpos)) (let ((h (st :input-history))) @@ -597,12 +588,12 @@ Event handlers + daemon I/O + main loop. nil)) (setf (st :dirty) (list nil nil t))))) ;; PageUp — scroll back by page (10 lines) - ((or (eq ch :ppage) (eql ch 339)) + ((eq ch :ppage) (let ((max-offset (max 0 (- (length (st :messages)) 1)))) (setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10)))) (setf (st :dirty) (list nil t nil))) ;; PageDown — scroll forward by page - ((or (eq ch :npage) (eql ch 338)) + ((eq ch :npage) (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10))) (setf (st :dirty) (list nil t nil))) ;; Printable @@ -613,7 +604,7 @@ Event handlers + daemon I/O + main loop. (t nil)))) (when (and chr (graphic-char-p chr)) (input-insert-char chr) - (setf (st :dirty) (list nil nil t)))))))) + (setf (st :dirty) (list nil nil t))))))) ;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny (defun resolve-hitl-panel (decision) @@ -844,7 +835,7 @@ Event handlers + daemon I/O + main loop. (let ((prev-fb (cl-tty.rendering:make-framebuffer w h)) (curr-fb (cl-tty.rendering:make-framebuffer w h))) ;; Initial render - (redraw be curr-fb w h) + (redraw curr-fb w h) (cl-tty.rendering:flush-framebuffer prev-fb curr-fb be) (rotatef prev-fb curr-fb) (loop while (st :running) do @@ -893,7 +884,7 @@ Event handlers + daemon I/O + main loop. (t (on-key ch))))))) (when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty))) (cl-tty.backend:backend-clear curr-fb) - (redraw be curr-fb w h) + (redraw curr-fb w h) (cl-tty.rendering:flush-framebuffer prev-fb curr-fb be) (rotatef prev-fb curr-fb)) (sleep 0.1)))) diff --git a/org/channel-tui-view.org b/org/channel-tui-view.org index cdadd9b..ed724bd 100644 --- a/org/channel-tui-view.org +++ b/org/channel-tui-view.org @@ -45,12 +45,25 @@ that the TUI actuator attaches to the response plist before transmission. #+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp (in-package :passepartout.channel-tui) +(defun word-wrap (text width) + "Wrap TEXT to at most WIDTH columns. Splits on word boundaries. +Returns a list of strings, one per line." + (let ((lines nil)) + (loop while (> (length text) width) + do (let ((break (or (position #\Space text :end width :from-end t) + width))) + (push (subseq text 0 break) lines) + (setf text (string-left-trim '(#\Space) + (subseq text break))))) + (push text lines) + (nreverse lines))) + (defun view-status (fb w) - (let ((degraded (and (find-package :passepartout) - (boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout)) - (member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout)) - '(:degraded :unhealthy)))) - (bg (if degraded :bright-yellow nil))) + (let* ((degraded (and (find-package :passepartout) + (boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout)) + (member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout)) + '(:degraded :unhealthy)))) + (bg (if degraded :bright-yellow nil))) ;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy (cl-tty.backend:draw-text fb 1 1 (format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a" diff --git a/passepartout b/passepartout index 6a79aa1..d049eaf 100755 --- a/passepartout +++ b/passepartout @@ -402,7 +402,7 @@ case "$COMMAND" in :direction :output :if-exists :supersede :if-does-not-exist :create) (format f "CRASH: ~a~%~%" c) (sb-debug:print-backtrace :count 50 :stream f) (finish-output f))) (format t "~%=== TUI CRASH ===~%CRASH: ~a~%" c) - (format t "Full backtrace saved to ~/.cache/passepartout/tui-crash.log~%") + (format t "Full backtrace saved to ~~/.cache/passepartout/tui-crash.log~%") (sleep 3) (finish-output) (uiop:quit 1)))) (passepartout.channel-tui:tui-main)) LISPEOF