94 lines
3.1 KiB
Scheme
94 lines
3.1 KiB
Scheme
(define-module (reflow wrap)
|
|
#:use-module (reflow ansi)
|
|
#:use-module (uniseg graphemes)
|
|
#:use-module (uniseg graphemes iterator)
|
|
#:use-module (ice-9 textual-ports)
|
|
#:export (make-wrapping-port-pair))
|
|
|
|
(define* (make-wrapping-port-pair
|
|
o-port
|
|
max-width
|
|
#:key (keep-newlines? #t)
|
|
(preserve-space? #f)
|
|
(tab-width 4))
|
|
"Return a soft port which wraps the given output port such that text cleanly wraps to a new line if longer than max width."
|
|
(define-values (ansi-port current-sequence reset-ansi restore-ansi)
|
|
(make-ansi-port-tuple o-port))
|
|
|
|
(define iterator (make-grapheme-iterator))
|
|
(define %cur-width 0)
|
|
(define %in-escape-seq? #f)
|
|
(define %waiting-for-non-space? #f)
|
|
|
|
(define (new-line)
|
|
(when (not preserve-space?)
|
|
(set! %waiting-for-non-space? #t))
|
|
(put-char ansi-port #\newline))
|
|
|
|
(define (handle-char char)
|
|
(cond
|
|
((eq? %ansi-marker char)
|
|
(set! %in-escape-seq? #t)
|
|
(put-char ansi-port char))
|
|
(%in-escape-seq?
|
|
(put-char ansi-port char)
|
|
(when (ansi-terminator? char)
|
|
(set! %in-escape-seq? #f)))
|
|
((eq? #\newline char)
|
|
(when keep-newlines?
|
|
(set! %cur-width 0)
|
|
(new-line)))
|
|
((and (char-set-contains? char-set:whitespace char)
|
|
%waiting-for-non-space?)
|
|
#f)
|
|
((eq? #\tab char)
|
|
(for-each handle-char (make-list tab-width #\space)))
|
|
(else
|
|
(set! %waiting-for-non-space? #f)
|
|
|
|
(let* ((grapheme (iterator char))
|
|
(new-width (+ %cur-width (grapheme-delta-width grapheme))))
|
|
|
|
(if (> new-width max-width)
|
|
(let* ((grapheme-width (grapheme-width grapheme))
|
|
(modification? (grapheme-modification? grapheme))
|
|
(grapheme-str (grapheme-string grapheme)))
|
|
;; If we go over the width, and the grapheme is a modification,
|
|
;; then we need to backspace to before the grapheme before we go to the next line.
|
|
(when modification?
|
|
(let* ((num-to-delete (- grapheme-width 1))
|
|
(delete-str (list->string (make-list num-to-delete #\backspace))))
|
|
(put-string ansi-port delete-str)))
|
|
|
|
;; Go to next line, restore ansi sequence, then print the entire grapheme!
|
|
(new-line)
|
|
(restore-ansi)
|
|
(put-string ansi-port grapheme-str)
|
|
(set! %cur-width grapheme-width))
|
|
(begin
|
|
;; Otherwise we can just output to the ansi port as normal.
|
|
(put-char ansi-port char)
|
|
(set! %cur-width new-width)))))))
|
|
|
|
(define output-port
|
|
(make-soft-port
|
|
(vector
|
|
;; Char out
|
|
handle-char
|
|
;; string out, char by char
|
|
(λ (s) (string-for-each handle-char s))
|
|
#f #f #f)
|
|
"w"))
|
|
|
|
(define (reset)
|
|
(set! iterator (make-grapheme-iterator))
|
|
(set! %cur-width 0)
|
|
(define-values (p cur reset restore)
|
|
(make-ansi-port-tuple o-port))
|
|
(set! ansi-port p)
|
|
(set! current-sequence cur)
|
|
(set! reset-ansi reset)
|
|
(set! restore-ansi restore))
|
|
|
|
(values output-port reset))
|