Removing hall cruft and adding uniseg properly, and finally, works!

guix.scm

@@ -30,11 +30,12 @@
   (arguments `())
   (native-inputs
     (list autoconf automake pkg-config texinfo))
-  (inputs (list guile-3.0 guile-uniseg))
-  (propagated-inputs (list))
+  (inputs (list guile-3.0))
+  (propagated-inputs (list guile-uniseg))
   (synopsis "Guile port of reflow")
   (description
     "A library to provide easy text wrapping in consoles that preserves control-code formatting.")
   (home-page
     "https://git.solarpunk.moe/vv/guile-reflow")
   (license license:gpl3+))
+

hall.scm

@@ -1,36 +0,0 @@
-(hall-description
-  (name "reflow")
-  (prefix "guile")
-  (version "0.1")
-  (author "Vivanne Langdon")
-  (email "")
-  (copyright (2024))
-  (synopsis "Guile port of reflow")
-  (description
-    "A library to provide easy text wrapping in consoles that preserves control-code formatting.")
-  (home-page
-    "https://git.solarpunk.moe/vv/guile-reflow")
-  (license gpl3+)
-  (dependencies `())
-  (skip ())
-  (features
-    ((guix #t)
-     (use-guix-specs-for-dependencies #f)
-     (native-language-support #f)
-     (licensing #f)))
-  (files (libraries
-           ((directory "reflow" ((scheme-file "ansi")))
-            (scheme-file "reflow")))
-         (tests ((directory "tests" ((scheme-file "test-ansi")))))
-         (programs ())
-         (documentation
-           ((org-file "README")
-            (symlink "README" "README.org")
-            (text-file "HACKING")
-            (text-file "COPYING")
-            (directory "doc" ((texi-file "guile-reflow")))))
-         (infrastructure
-           ((scheme-file "guix")
-            (text-file ".gitignore")
-            (scheme-file "hall")
-            (directory "tests" ())))))

reflow/ansi.scm

@@ -1,12 +1,15 @@
 (define-module (reflow ansi)
   #:use-module (rnrs io ports)
-  #:use-module (ice-9 binary-ports)
-  #:export (make-ansi-port-tuple))
+  #:export (%ansi-marker
+            %reset
+            %reset-seq
+            ansi-terminator?
+            make-ansi-port-tuple))
 
-(define %MARKER #\x1b)
-(define %RESET "[0m")
-(define %RESET-SEQ
-  (string-append (string %MARKER) %RESET))
+(define %ansi-marker #\x1b)
+(define %reset "[0m")
+(define %reset-seq
+  (string-append (string %ansi-marker) %reset))
 
 (define (ansi-terminator? char)
   (let ((c (char->integer char)))
@@ -35,7 +38,7 @@
   (define (put-char c)
     (cond
      ;; If we see a marker, flag it and begin building the sequence list
-     ((equal? %MARKER c)
+     ((equal? %ansi-marker c)
       (set! in-escape-sequence? #t)
       (cons! c wip-sequence-list))
      (in-escape-sequence?
@@ -48,7 +51,7 @@
         (let ((sequence (reverse-list->string wip-sequence-list)))
           (cond
            ;; Is it a reset sequence? Clear it
-           ((string-suffix? %RESET sequence)
+           ((string-suffix? %reset sequence)
             (set! current-sequence-list '()))
            ;; Is it a color code? Add it to the sequence!
            ((equal? c #\m)
@@ -66,12 +69,11 @@
     (make-soft-port
      (vector
       ;; Char out
-      (λ (c) (put-char c))
+      put-char
       ;; String out, go char by char
       (λ (s) (string-for-each put-char s))
       ;; Flush
-      ;; (question: do we want to force output work-in-progress sequences on flush? Probably not?)
-      (λ () (flush-output-port o-port))
+      (λ () #f)
       ;; Get char - write-only, we ignore
       (λ () #f)
       ;; Close port - no work to do - we don't take ownership of the child port
@@ -92,7 +94,7 @@
   (define (reset-ansi)
     "Reset the current ansi sequence if needed by outputting to the wrapped port."
     (when (sequence?)
-      (display %RESET-SEQ o-port)))
+      (display %reset-seq o-port)))
 
   (define (restore-ansi)
     "Restore the current ansi sequence by outputting to the wrapped port."

reflow/hconfig.scm

@@ -1,35 +0,0 @@
-(define-module
-  (reflow hconfig)
-  #:use-module
-  (srfi srfi-26)
-  #:export
-  (%version
-    %author
-    %license
-    %copyright
-    %gettext-domain
-    G_
-    N_
-    init-nls
-    init-locale))
-
-(define %version "0.1")
-
-(define %author "Vivanne Langdon")
-
-(define %license 'gpl3+)
-
-(define %copyright '(2024))
-
-(define %gettext-domain "guile-reflow")
-
-(define G_ identity)
-
-(define N_ identity)
-
-(define (init-nls) "Dummy as no NLS is used" #t)
-
-(define (init-locale)
-  "Dummy as no NLS is used"
-  #t)
-

reflow/wrap.scm

@@ -0,0 +1,93 @@
+(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))