Files
passepartout/lisp/gateway-tui-view.lisp
Amr Gharbeia 0861ac26f1
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
v0.3.3: word wrap in view-chat — break at word boundaries
Adds word-wrap(text width) — splits strings into lines at word
boundaries respecting terminal width. Rewrites view-chat to:
- Wrap each message with word-wrap before rendering
- Render each wrapped line as a separate add-string call
- Account for wrapped line count in visible-message calculation

RED proof: tmux capture shows messages split mid-word at terminal edge.
GREEN proof: tmux capture shows clean word-boundary wrapping:
  The quick brown fox jumps over the lazy dog while the cat naps
  peacefully in the sunny garden
2026-05-06 17:14:49 -04:00

102 lines
4.4 KiB
Common Lisp

(in-package :passepartout.gateway-tui)
(defun view-status (win)
(clear win)
(box win 0 0)
(add-string win
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(if (st :busy) " …thinking" ""))
:y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
(add-string win (format nil " ~a" (now)) :y 2 :x 1 :fgcolor (theme-color :timestamp))
(refresh win))
(defun word-wrap (text width)
"Break text into lines at word boundaries, each <= width chars.
Returns list of trimmed strings. Single words wider than width are split."
(let ((lines '())
(pos 0)
(len (length text)))
(loop while (< pos len)
do (let ((end (min len (+ pos width))))
(cond
((>= end len)
(push (string-trim '(#\Space) (subseq text pos len)) lines)
(setf pos len))
((char= (char text (1- end)) #\Space)
(push (string-trim '(#\Space) (subseq text pos end)) lines)
(setf pos end))
(t
(let ((last-space (position #\Space text :from-end t :end (1+ end) :start pos)))
(if (and last-space (> last-space pos))
(progn
(push (string-trim '(#\Space) (subseq text pos last-space)) lines)
(setf pos (1+ last-space)))
(progn
(push (string-trim '(#\Space) (subseq text pos end)) lines)
(setf pos end))))))))
(nreverse lines)))
(defun view-chat (win h)
(clear win)
(box win 0 0)
(let* ((w (or (width win) 78))
(msgs (reverse (st :messages)))
(max-lines (- h 2))
(y 1))
;; Count visible messages from end, accounting for word wrap
(let* ((msg-count 0)
(lines-remaining max-lines))
;; Walk from most recent backwards, counting wrapped lines
(let ((visible-msgs (reverse msgs)))
(loop for msg in visible-msgs
while (> lines-remaining 0)
do (let* ((role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(line-text (format nil "~a [~a] ~a" prefix time content))
(wrapped (word-wrap line-text (- w 2)))
(nlines (length wrapped)))
(if (<= nlines lines-remaining)
(progn (decf lines-remaining nlines) (incf msg-count))
(setf lines-remaining 0))))
;; Render from the correct starting message
(let* ((total (length msgs))
(scroll-skip (st :scroll-offset))
(start (max 0 (- total msg-count scroll-skip))))
(loop for i from start below total
while (< y (1- h))
do (let* ((msg (nth i msgs))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent))))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(line-text (format nil "~a [~a] ~a" prefix time content))
(wrapped (word-wrap line-text (- w 2))))
(dolist (line wrapped)
(when (< y (1- h))
(add-string win line :y y :x 1 :n (1- w) :fgcolor color)
(incf y)))))))))
(refresh win))
(defun view-input (win)
(let* ((text (input-string))
(w (or (width win) 78))
(clip (min (length text) (1- w))))
(clear win)
(add-string win (format nil "~a " text) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 clip)))
(refresh win))
(defun redraw (sw cw ch iw)
(destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw))
(when cd (view-chat cw ch))
(when id (view-input iw))
(setf (st :dirty) (list nil nil nil))))