Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
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
102 lines
4.4 KiB
Common Lisp
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))))
|