diff --git a/reflow/wrap.scm b/reflow/wrap.scm index 8a7da57..fb67ac7 100644 --- a/reflow/wrap.scm +++ b/reflow/wrap.scm @@ -1,11 +1,13 @@ (define-module (reflow wrap) #:use-module (reflow ansi) + #:use-module (uniseg) #:use-module (uniseg graphemes) #:use-module (uniseg graphemes iterator) #:use-module (ice-9 textual-ports) - #:export (make-wrapping-port-pair)) + #:use-module (srfi srfi-26) + #:export (make-wrapping-port)) -(define* (make-wrapping-port-pair +(define* (make-wrapping-port o-port max-width #:key (keep-newlines? #t) @@ -20,6 +22,11 @@ (define %in-escape-seq? #f) (define %waiting-for-non-space? #f) + (define (put-n-times char num) + (do ((i 1 (1+ 1))) + ((> i num)) + (put-char ansi-port char))) + (define (new-line) (when (not preserve-space?) (set! %waiting-for-non-space? #t)) @@ -27,22 +34,38 @@ (define (handle-char char) (cond + ;; Track when we are in an escape sequence ((eq? %ansi-marker char) (set! %in-escape-seq? #t) (put-char ansi-port char)) + + ;; Skip processing escape sequences and track when we leave escape sequence (%in-escape-seq? (put-char ansi-port char) (when (ansi-terminator? char) (set! %in-escape-seq? #f))) + + ;; Support for stripping spaces from front of newline ((eq? #\newline char) (when keep-newlines? (set! %cur-width 0) (new-line))) + + ;; Skip whitespace at beginning of line if configured ((and (char-set-contains? char-set:whitespace char) %waiting-for-non-space?) #f) + + ;; Convert tabs to desired number of spaces ((eq? #\tab char) (for-each handle-char (make-list tab-width #\space))) + + ;; Subtract backspaces from width + ((eq? #\backspace char) + (set! %cur-width (- %cur-width 1)) + (put-char ansi-port char)) + + ;; Main processing area (else (set! %waiting-for-non-space? #f) @@ -50,21 +73,33 @@ (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))) + (let* ((g-width (grapheme-width grapheme)) + (g-modification? (grapheme-modification? grapheme)) + (g-string (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))) + ;; But we also need to add spaces to fill in the characters already printed! + (when g-modification? + (let* ((num-to-delete (- g-width 1))) + (put-n-times #\backspace num-to-delete) + (put-n-times #\space num-to-delete))) - ;; Go to next line, restore ansi sequence, then print the entire grapheme! + ;; This possibly sets %waiting-for-non-space = #t + ;; and we need to handle it. (new-line) + (when %waiting-for-non-space? + ;; Remove all whitespace chars from the grapheme + (set! g-string (string-filter (λ (c) (not (char-set-contains? char-set:whitespace c))) g-string)) + ;; Recalculate width with remaining characters + (set! g-width (string-width g-string)) + + ;; If anything is left, we have satisfied the newline non-space check already + (when (> (string-length g-string) 0) + (set! %waiting-for-non-space? #f))) (restore-ansi) - (put-string ansi-port grapheme-str) - (set! %cur-width grapheme-width)) + (put-string ansi-port g-string) + (set! %cur-width g-width)) + (begin ;; Otherwise we can just output to the ansi port as normal. (put-char ansi-port char) @@ -80,14 +115,4 @@ #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)) + output-port) diff --git a/tests/test-wrap.scm b/tests/test-wrap.scm index b996329..8de1cde 100644 --- a/tests/test-wrap.scm +++ b/tests/test-wrap.scm @@ -8,8 +8,8 @@ (verify-output "hello ther\ne \x1b[3mHowdy! H\n\x1b[3mow are you\n\x1b[3m? \x1b[0mThis is \nfun, \x1b[5misn't\n\x1b[5m it tho?\x1b[0m\n I disa\ngree. I fi\nnd it \x1b[2mtedi\n\x1b[2mous\n" - (define-values (port reset) - (make-wrapping-port-pair (current-output-port) 10 #:preserve-space? #t)) + (define port + (make-wrapping-port (current-output-port) 10 #:preserve-space? #t)) (display "hello there \x1b[3mHowdy! How are you? \x1b[0mThis is fun, \x1b[5misn't it tho?\x1b[0m\n\tI disagree. I find it \x1b[2mtedious\n" port)) @@ -20,12 +20,19 @@ ;; Trans Rights ;; 🏳️‍⚧️ Are Human R ;; ights - (verify-output - "\x1b[1m\x1b[3mTrans \x1b[0m\x1b[3mRights 🏳️\u200d\b\b\n\x1b[1m;3m🏳️‍⚧️ \x1b[0mAre \x1b[3mHuman \x1b[0mR\nights" - (define-values (port reset) - (make-wrapping-port-pair (current-output-port) 14)) + "\x1b[1m\x1b[3mTrans \x1b[0m\x1b[3mRights 🏳️\u200d\b \n\x1b[3m🏳️‍⚧️ \x1b[0mAre \x1b[3mHuman \x1b[0mR\nights" + (define port + (make-wrapping-port (current-output-port) 14)) (display "\x1b[1m\x1b[3mTrans \x1b[0m\x1b[3mRights 🏳️‍⚧️ \x1b[0mAre \x1b[3mHuman \x1b[0mRights" port)) +;; I wish i were +;; a, but then ag +;; ain, no +(verify-output + "I wish I were \na sculptor\b\b\b\b\b\b\b\b\b, but then ag\nain, no" + (define port + (make-wrapping-port (current-output-port) 14)) + (display "I wish I were a sculptor\b\b\b\b\b\b\b\b\b, but then again, no" port)) (test-end "test-wrap")