Working word wrap, supporting backspaces and emoji!

- Removed the 'pair' syntax as it isn't needed
- Add comments
- Fix unit tests

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))
+            (let* ((g-width (grapheme-width grapheme))
-                   (modification? (grapheme-modification? grapheme))
+                   (g-modification? (grapheme-modification? grapheme))
-                   (grapheme-str (grapheme-string 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?
+              ;; But we also need to add spaces to fill in the characters already printed!
-                (let* ((num-to-delete (- grapheme-width 1))
+              (when g-modification?
-                       (delete-str (list->string (make-list num-to-delete #\backspace))))
+                (let* ((num-to-delete (- g-width 1)))
-                  (put-string ansi-port delete-str)))
+                  (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)
+              (put-string ansi-port g-string)
-              (set! %cur-width grapheme-width))
+              (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)
+  output-port)
-    (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))

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)
+ (define port
-   (make-wrapping-port-pair (current-output-port) 10 #:preserve-space? #t))
+   (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"
+ "\x1b[1m\x1b[3mTrans \x1b[0m\x1b[3mRights 🏳️\u200d\b \n\x1b[3m🏳️‍⚧️ \x1b[0mAre \x1b[3mHuman \x1b[0mR\nights"
- (define-values (port reset)
+ (define port
-   (make-wrapping-port-pair (current-output-port) 14))
+   (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")