From a418a180b9eb1c542ab3fc1f3651ce6244965862 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Fri, 28 Aug 2020 00:59:14 +0200
Subject: Some clarifications in text submodules.

---
 module/text/flow.scm   | 47 ++++++++++++++++++++++++++---------------------
 module/text/markup.scm |  7 +++++--
 module/text/util.scm   | 11 +++++++++--
 3 files changed, 40 insertions(+), 25 deletions(-)

diff --git a/module/text/flow.scm b/module/text/flow.scm
index b9f0e387..528650a5 100644
--- a/module/text/flow.scm
+++ b/module/text/flow.scm
@@ -1,3 +1,8 @@
+;;; Commentary:
+;;; @var{flow-text} take a (multiline) string, and justifies
+;;; its contents. All linebreaks are treated as hard line breaks.
+;;; Code:
+
 (define-module (text flow)
   :use-module (calp util)
   :use-module (text util)
@@ -5,22 +10,11 @@
   )
 
 
-
-;; (str) -> str
-(define* (justify-line-helper words #:key (width 70))
-  (let* ((phrase-length (true-string-length (string-concatenate/shared words)))
-         (needed-spaces (- width phrase-length))
-         (slots (1- (length words)))
-         (space-list
-          (let loop ((n needed-spaces) (d slots))
-            (unless (zero? d)
-              (let ((v (round (/ n d))))
-                (cons v (loop (- n v)
-                              (1- d))))))))
-    (string-concatenate/shared
-     (merge words (map (lambda (n) (make-string n #\space))
-                       space-list)
-            (let ((f #t)) (lambda _ (set/r! f = not)))))))
+;; str -> (str)
+(define*-public (flow-text str #:key (width 70))
+  (flatten
+   (map (lambda (line) (justify-line line #:width width))
+        (lines str))))
 
 
 
@@ -44,8 +38,19 @@
             (else (cons (justify-line-helper head #:width width)
                         (recur tail)))))))
 
-;; str -> (str)
-(define*-public (flow-text str #:key (width 70))
-  (flatten
-   (map (lambda (line) (justify-line line #:width width))
-        (lines str))))
+;; (str) -> str
+(define* (justify-line-helper words #:key (width 70))
+  (let* ((phrase-length (true-string-length (string-concatenate/shared words)))
+         (needed-spaces (- width phrase-length))
+         (slots (1- (length words)))
+         (space-list
+          (let loop ((n needed-spaces) (d slots))
+            (unless (zero? d)
+              (let ((v (round (/ n d))))
+                (cons v (loop (- n v)
+                              (1- d))))))))
+    (string-concatenate/shared
+     (merge words (map (lambda (n) (make-string n #\space))
+                       space-list)
+            (let ((f #t)) (lambda _ (set/r! f = not)))))))
+
diff --git a/module/text/markup.scm b/module/text/markup.scm
index 7e625725..b74fd169 100644
--- a/module/text/markup.scm
+++ b/module/text/markup.scm
@@ -7,6 +7,11 @@
   :use-module (text flow)
   :use-module (texinfo string-utils))
 
+;; Takes an HTML-like sxml coded tree, and produces a string with
+;; appropriate spacing and ANSI-escapes for different tags.
+(define-public (sxml->ansi-text tree)
+  ((parse-tree ontree onleaf) tree))
+
 
 (define (esc . effect)
   (format #f "\x1b[~am"
@@ -117,5 +122,3 @@
     [any (leaf-callback any)]))
 
 
-(define-public (sxml->ansi-text tree)
-  ((parse-tree ontree onleaf) tree))
diff --git a/module/text/util.scm b/module/text/util.scm
index b2560bf4..b87e29f2 100644
--- a/module/text/util.scm
+++ b/module/text/util.scm
@@ -1,5 +1,10 @@
+;;; Commentary:
+;;; Small utility functions which helps the rest of the text processing.
+;;; Code:
+
 (define-module (text util)
-  :use-module (calp util))
+  :use-module ((calp util) :select (define*-public intersperce) )
+  )
 
 (define-public (words str) (string-split str #\space))
 (define-public (unwords list) (string-join list " " 'infix))
@@ -40,6 +45,8 @@
   (cond [(null? list) ""]
         [(= 1 (length list)) (car list)]
         [else
-         (let* (((tail . rest) (reverse list)))
+         (let* ((rev (reverse list))
+                (tail (car rev))
+                (rest (cdr rev)))
            (reverse (cons* tail " " final-delim " "
                            (intersperce ", " rest))))]))
-- 
cgit v1.2.3