TUI: fix infinite loop in wrap-one-line when a line is already full
ober
337332af26aa5cad486e27fa78d534c6f36f7339
--- a/src/jcode/ui/tui-message.ss +++ b/src/jcode/ui/tui-message.ss @@ -69,36 +69,47 @@ (def (wrap-one-line segs width) "Wrap a single line of segments into multiple lines if needed." - (let loop ((segs segs) (cur-line '()) (col 0) (out '())) - (cond - ((null? segs) - (reverse (if (null? cur-line) out (cons (reverse cur-line) out)))) - (else - (let* ((seg (car segs)) - (text (car seg)) - (face (cdr seg)) - (len (string-length text))) - (if (<= (+ col len) width) - ;; Fits on current line - (loop (cdr segs) (cons seg cur-line) (+ col len) out) - ;; Need to break this segment - (let break ((pos 0) (cur-line cur-line) (col col) (out out)) - (let ((remaining (- len pos)) - (avail (- width col))) - (cond - ((<= remaining 0) - (loop (cdr segs) cur-line col out)) - ((<= remaining avail) - (loop (cdr segs) - (cons (cons (substring text pos len) face) cur-line) - (+ col remaining) out)) - (else - ;; Fill current line, start new one - (let ((chunk (substring text pos (+ pos avail)))) - (break (+ pos avail) - '() - 0 - (cons (reverse (cons (cons chunk face) cur-line)) out))))))))))))) + ;; Treat non-positive widths as 1 so we always make forward progress. + ;; Otherwise avail can reach 0 below and the break loop spins forever. + (let ((width (max 1 width))) + (let loop ((segs segs) (cur-line '()) (col 0) (out '())) + (cond + ((null? segs) + (reverse (if (null? cur-line) out (cons (reverse cur-line) out)))) + (else + (let* ((seg (car segs)) + (text (car seg)) + (face (cdr seg)) + (len (string-length text))) + (if (<= (+ col len) width) + ;; Fits on current line + (loop (cdr segs) (cons seg cur-line) (+ col len) out) + ;; Need to break this segment + (let break ((pos 0) (cur-line cur-line) (col col) (out out)) + (let ((remaining (- len pos)) + (avail (- width col))) + (cond + ((<= remaining 0) + (loop (cdr segs) cur-line col out)) + ;; Previous segments filled the row — flush and retry + ;; at col=0. Without this, avail=0 causes infinite + ;; recursion on any non-empty remaining text. + ((<= avail 0) + (break pos '() 0 + (if (null? cur-line) + out + (cons (reverse cur-line) out)))) + ((<= remaining avail) + (loop (cdr segs) + (cons (cons (substring text pos len) face) cur-line) + (+ col remaining) out)) + (else + ;; Fill current line, start new one + (let ((chunk (substring text pos (+ pos avail)))) + (break (+ pos avail) + '() + 0 + (cons (reverse (cons (cons chunk face) cur-line)) out)))))))))))))) ;; ---- Reflow: re-render message for given width ----