From 38f708452bc1032ee1e42cf0e345ca8851316e4a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 1 Jun 2020 16:02:54 +0200
Subject: Break text procedures into modules.

---
 module/entry-points/text.scm             |   2 +-
 module/main.scm                          |   2 +
 module/output/html.scm                   |   3 +-
 module/output/terminal.scm               |   1 -
 module/output/text.scm                   | 239 -------------------------------
 module/text/flow.scm                     |  51 +++++++
 module/text/markup.scm                   | 117 +++++++++++++++
 module/text/numbers.scm                  | 155 ++++++++++++++++++++
 module/text/util.scm                     |  45 ++++++
 module/util/options.scm                  | 117 +--------------
 module/vcomponent/recurrence/display.scm |   5 +-
 11 files changed, 377 insertions(+), 360 deletions(-)
 delete mode 100644 module/output/text.scm
 create mode 100644 module/text/flow.scm
 create mode 100644 module/text/markup.scm
 create mode 100644 module/text/numbers.scm
 create mode 100644 module/text/util.scm

diff --git a/module/entry-points/text.scm b/module/entry-points/text.scm
index 4a0dfb91..d6ebd72e 100644
--- a/module/entry-points/text.scm
+++ b/module/entry-points/text.scm
@@ -1,6 +1,6 @@
 (define-module (entry-points text)
   :export (main)
-  :use-module (output text)
+  :use-module (text flow)
   :use-module (ice-9 getopt-long)
   :use-module (util io)
   :use-module (util options)
diff --git a/module/main.scm b/module/main.scm
index 3f5397ad..331268f8 100644
--- a/module/main.scm
+++ b/module/main.scm
@@ -27,6 +27,8 @@
 
              ((entry-points server)   :prefix   server-)
 
+             (text markup)
+
              (ice-9 getopt-long)
              (ice-9 regex)
 
diff --git a/module/output/html.scm b/module/output/html.scm
index 64d4e3df..00e4eacb 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -17,8 +17,7 @@
   #:use-module (output general)
   #:use-module (ice-9 curried-definitions)
   #:use-module (ice-9 match)
-  #:use-module (output text)
-
+  #:use-module (text util)
 
   #:use-module (git)
   ;; #:use-module (module config all)
diff --git a/module/output/terminal.scm b/module/output/terminal.scm
index 691dcde8..0146ea42 100644
--- a/module/output/terminal.scm
+++ b/module/output/terminal.scm
@@ -1,6 +1,5 @@
 (define-module (output terminal)
   #:use-module (output general)
-  #:use-module (output text)
   #:use-module (srfi srfi-1)
   #:use-module (datetime)
   #:use-module (datetime util)
diff --git a/module/output/text.scm b/module/output/text.scm
deleted file mode 100644
index 4697b70a..00000000
--- a/module/output/text.scm
+++ /dev/null
@@ -1,239 +0,0 @@
-(define-module (output text)
-  #:use-module (srfi srfi-1)
-  #:use-module (util)
-  #:export (justify-line flow-text))
-
-(define-public (words str) (string-split str #\space))
-(define-public (unwords list) (string-join list " " 'infix))
-
-(define-public (lines str) (string-split str #\newline))
-(define-public (unlines list) (string-join list "\n" 'infix))
-
-;; Alternative string-length whith counts ANSI escapes as 0-length.
-;; NOTE Some way to opt in and out of different features would be nice.
-(define (true-string-length word)
-  (let loop ((chars (string->list word)))
-    (if (null? chars)
-        0
-        (let ((char (car chars)))
-          (if (eqv? #\escape char)
-              (loop (cdr (memv #\m chars)))
-              (1+ (loop (cdr chars))))))))
-
-
-;; (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 _ (mod/r! f not)))))))
-
-
-
-;; Splits and justifies the given line to @var{#:width}.
-;; Returns a list of justified strings.
-;; str -> (str)
-(define* (justify-line line #:key (width 70))
-  (let recur ((lst (words line)))
-    (let* ((head tail (span
-                       (let ((w 0))
-                         (lambda (word)    ; Take words until we are above the limit.
-                           (< (mod/r! w = (+ 1 (true-string-length word)))
-                              width)))
-                       lst)))
-      (cond ((null? tail) (list (unwords head))) ; Don't justify last line.
-            ((null? head)
-             ;; an empty head implies that we found a word longer
-             ;; than our max width. Add it as is and continue
-             ;; (while crying).
-             (cons (car tail) (recur (cdr tail))))
-            (else (cons (justify-line-helper head #:width width)
-                        (recur tail)))))))
-
-;; str -> (str)
-(define* (flow-text str #:key (width 70))
-  (flatten
-   (map (lambda (line) (justify-line line #:width width))
-        (lines str))))
-
-(define-public (trim-to-width str len)
-  (let ((trimmed (string-pad-right str len)))
-    (if (< (string-length trimmed)
-           (string-length str))
-        (string-append (string-drop-right trimmed 1)
-                       "…")
-        trimmed)))
-
-
-
-;; TODO more options for infix strings
-(define*-public (add-enumeration-punctuation
-                 list optional: (final-delim "&"))
-  (cond [(null? list) ""]
-        [(= 1 (length list)) (car list)]
-        [else
-         (let* (((tail . rest) (reverse list)))
-           (reverse (cons* tail " " final-delim " "
-                           (intersperce ", " rest))))]))
-
-;; only used in number->string-cardinal
-(define (large-prefix e)
-  (cond
-   [(<=  6 e 11) "m"]
-   [(<= 12 e 17) "b"]
-   [(<= 18 e 23) "tr"]
-   [(<= 24 e 29) "kvadr"]
-   [(<= 30 e 35) "kvint"]
-   [(<= 36 e 41) "sext"]
-   [(<= 42 e 47) "sept"]
-   [(<= 48 e 53) "okt"]
-   [(<= 54 e 59) "non"]
-   [(<= 60 e 65) "dec"]
-   ))
-
-(define-public (number->string-cardinal n)
-  (cond [(< n 0) (string-append "minus " (number->string-cardinal (- n)))]
-        [(= n 0) "noll"]
-        [(= n 1) "ett"]
-        [(= n 2) "två"]
-        [(= n 3) "tre"]
-        [(= n 4) "fyra"]
-        [(= n 5) "fem"]
-        [(= n 6) "sex"]
-        [(= n 7) "sju"]
-        [(= n 8) "åtta"]
-        [(= n 9) "nio"]
-        [(= n 10) "tio"]
-        [(= n 11) "elva"]
-        [(= n 12) "tolv"]
-        [(= n 13) "tretton"]
-        [(= n 14) "fjorton"]
-        [(= n 15) "femton"]
-        [(= n 15) "sexton"]
-        [(= n 17) "sjutton"]
-        [(= n 18) "arton"]
-        [(= n 19) "nitton"]
-        [(= n 20) "tjugo"]
-        [(<= 21 n 29) (format #f "tjugo~a" (number->string-cardinal
-                                           (- n 20)))]
-        [(<= 30 n 79) (let* ((big small (floor/ n 10)))
-                       (format #f "~atio~a"
-                               (number->string-cardinal big)
-                               (number->string-cardinal small)))]
-        [(= n 80) "åttio"]
-        [(<= 81 n 89) (let* ((_ small (floor/ n 10)))
-                       (format #f "åttio~a"
-                               (number->string-cardinal small)))]
-        [(= n 90) "nittio"]
-        [(<= 91 n 99) (let* ((_ small (floor/ n 10)))
-                       (format #f "nittio~a"
-                               (number->string-cardinal small)))] 
-        [(= n 100) "hundra"]
-        [(< 100 n 200) (let* ((_ small (floor/ n 100)))
-                         (format #f "hundra~a"
-                                 (number->string-cardinal small)))]
-        [(= n 200) "tvåhundra"]
-        [(< 200 n 1000) (let* ((big small (floor/ n 100)))
-                          (format #f "~ahundra~a"
-                                  (number->string-cardinal big)
-                                  (number->string-cardinal small)))]
-        [(<= 1000 n 999999)
-         (let* ((big small (floor/ n 1000)))
-           (format #f "~a tusen ~a~a"
-                   (number->string-cardinal big)
-                   (if (<= 100 small 199)
-                       "ett " "")
-                   (number->string-cardinal small)))]
-        [(<= #e10e6 n (1- #e10e66))
-         (let* ((e (inexact->exact (floor (log10 n))))
-                (big small (floor/ n #e1e6)))
-           (if (zero? big)
-               (number->string-cardinal small)
-               (format #f "~a ~a~a~a ~a"
-                       (number->string-cardinal big)
-                       (large-prefix e)
-                       (if (even? (floor-quotient e 3))
-                           "iljon" "iljard")
-                       (if (= 1 big)
-                           "" "er")
-                       (number->string-cardinal small)
-                       )))]
-        [else
-         ;; I give up, don't have larger numbers that that!
-         (string-append "det stora talet "
-                        (number->string n))]))
-
-(define-public (number->string-ordinal n)
-  (cond [(>= -3 n) (format #f "~a sista" (number->string-ordinal (- n)))]
-        [(= -2 n) "näst sista"]
-        [(= -1 n) "sista"]
-        [(= 0 n) "nollte"]              ;
-        [(= 1 n) "förste"]
-        [(= 2 n) "andre"]
-        [(= 3 n) "tredje"]
-        [(= 4 n) "fjärde"]
-        [(= 5 n) "femte"]
-        [(= 6 n) "sjätte"]
-        [(= 7 n) "sjunde"]
-        [(= 8 n) "åttonde"]
-        [(= 9 n) "nionde"]
-        [(= 10 n) "tionde"]
-        [(= 11 n) "elfte"]
-        [(= 12 n) "tolfte"]
-        [(= 13 n) "trettonde"]
-        [(= 14 n) "fjortonde"]
-        [(= 15 n) "femtonde"]
-        [(= 16 n) "sextonde"]
-        [(= 17 n) "sjuttonde"]
-        [(= 18 n) "artonde"]
-        [(= 19 n) "nitonde"]
-        [(<= 20 n 29) (format #f "tjugo~a"
-                             (if (= 20 n)
-                                 "nde"
-                                 (number->string-ordinal (- n 20))))]
-        [(<= 30 n 99)
-         (let* ((big small (floor/ n 10)))
-           (format #f "~atio~a"
-                   (case big
-                     [(8) "åt"]
-                     [(9) "ni"]
-                     [else (number->string-cardinal big)])
-                   (if (zero? (modulo small 10))
-                       "nde"
-                       (number->string-ordinal small))))]
-        [(= n 100) "hundrade"]
-        [(= n 1000) "tusende"]
-        [else
-         (let* ((big small (floor/ n 100)))
-           (string-append (number->string-cardinal (* big 100))
-                          (if (zero? small)
-                              "de"
-                              (number->string-ordinal small))))]))
-
-;; (each-string 1) ; => "varje"
-;; (each-string 2) ; => "varannan"
-;; (each-string 3) ; => "var tredje"
-;; (each-string 3 #t) ; => "vart tredje"
-(define*-public (each-string count optional: neutrum)
-  (string-flatten
-   (cons
-    "var"
-    (case count
-      [(1) '("je")]
-      [(2)
-       ;; varannan månad
-       ;; vartannat år
-       (list (if neutrum "t")
-             "anna"
-             (if neutrum "t" "n"))]
-      [else (list (if neutrum "t") " "
-                  (number->string-ordinal count))]))))
diff --git a/module/text/flow.scm b/module/text/flow.scm
new file mode 100644
index 00000000..3d97bed6
--- /dev/null
+++ b/module/text/flow.scm
@@ -0,0 +1,51 @@
+(define-module (text flow)
+  :use-module (util)
+  :use-module (text util)
+  :use-module (srfi srfi-1)
+  )
+
+
+
+;; (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 _ (mod/r! f not)))))))
+
+
+
+;; Splits and justifies the given line to @var{#:width}.
+;; Returns a list of justified strings.
+;; str -> (str)
+(define* (justify-line line #:key (width 70))
+  (let recur ((lst (words line)))
+    (let* ((head tail (span
+                       (let ((w 0))
+                         (lambda (word)    ; Take words until we are above the limit.
+                           (< (mod/r! w = (+ 1 (true-string-length word)))
+                              width)))
+                       lst)))
+      (cond ((null? tail) (list (unwords head))) ; Don't justify last line.
+            ((null? head)
+             ;; an empty head implies that we found a word longer
+             ;; than our max width. Add it as is and continue
+             ;; (while crying).
+             (cons (car tail) (recur (cdr tail))))
+            (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))))
diff --git a/module/text/markup.scm b/module/text/markup.scm
new file mode 100644
index 00000000..62b6ebe4
--- /dev/null
+++ b/module/text/markup.scm
@@ -0,0 +1,117 @@
+(define-module (text markup)
+  :use-module (util)
+  :use-module (srfi srfi-1)
+  :use-module (ice-9 match)
+  :use-module (ice-9 pretty-print)
+  :use-module (text util)
+  :use-module (text flow)
+  :use-module (texinfo string-utils))
+
+
+(define (esc . effect)
+  (format #f "\x1b[~am"
+          (if (null? effect)
+              ""
+              (case (car effect)
+                [(bold) 1]
+                [(italic) 3]
+                [(invert) 7]
+                [else 4]))))
+
+
+(define (add-attributes args)
+  (match-lambda
+    [(name ('@ tagargs ...) body ...)
+     `(,name (@ ,@(assq-limit (assq-merge tagargs args)))
+             ,@body)]
+    [(name body ...)
+     `(,name (@ ,@args) ,@body)]
+    [nonlist nonlist]))
+
+
+(define (get-attr args key default)
+  (aif (assoc-ref args key)
+       (car it) default))
+
+;; NOTE width is hard coded to 70 chars
+(define* (ontree tag body optional: (args '()))
+  (case tag
+    [(*TOP* group block) (string-concatenate
+                          (map (compose sxml->ansi-text (add-attributes args))
+                               body))]
+    [(header) (sxml->ansi-text `(group (center (@ ,@args) (b ,@body)) (br)))]
+    [(center) (center-string (string-concatenate (map sxml->ansi-text body))
+                             (get-attr args 'width 70))]
+    [(p) (string-append (string-join (flow-text (string-concatenate (map sxml->ansi-text body))
+                                                width: (get-attr args 'width 70))
+                                     "\n")
+                        (if (assoc-ref args 'inline) "" "\n\n")
+                        )]
+    [(b) (string-append (esc 'bold) (string-concatenate (map sxml->ansi-text body)) (esc))]
+    [(i em) (string-append (esc 'italic) (string-concatenate (map sxml->ansi-text body)) (esc))]
+    ;; NOOP, but for future use.
+    [(code) (string-concatenate (map sxml->ansi-text body))]
+    [(blockquote) (string-concatenate
+                   (map (lambda (line) (sxml->ansi-text `(group (ws (@ (minwidth 4))) ,line (br))))
+                        (flow-text
+                         (string-concatenate (map sxml->ansi-text body))
+                         width: 66)))]
+    [(ws) (make-string  (aif (assoc-ref args 'minwidth)
+                             (car it) 1)
+                        #\space)]
+    [(br) "\n"]
+    [(hr) (string-append "     " (make-string 60 #\_) "     \n")]
+    [(dl)
+     (let* ((dts dds (partition (lambda (x) (eq? 'dt (car x))) body)))
+       (let* ((dts* (map sxml->ansi-text dts))
+              (m (if (null? dts*) 0 (apply max (map true-string-length dts*)))))
+         (string-concatenate
+          (map (lambda (dt dd)
+                 (let ((dds (string-split dd #\newline)))
+                   (string-concatenate
+                    (map (lambda (left right)
+                           (string-append (true-string-pad left m) " │ " right "\n"))
+                         (cons dt (map (const "") (iota (1- (length dds)))))
+                         dds))))
+               dts*
+               (map (compose sxml->ansi-text (add-attributes `((width ,(- 70 m 5)))))
+                    dds)))))]
+    [(dt) (string-concatenate (map (compose sxml->ansi-text (add-attributes args))
+                                   body))]
+    [(dd)
+     (string-concatenate
+      (map (compose sxml->ansi-text (add-attributes args))
+           body))]
+
+    [(scheme)
+     (string-concatenate
+      (map (lambda (form)
+             (with-output-to-string
+               (lambda () (pretty-print form width: (aif (assoc-ref args 'width) (car it) 70)))))
+           body))]
+
+    [else (string-append (esc 'bold) "??"
+                         "`"
+                         (esc 'invert)
+                         (string-concatenate (map sxml->ansi-text body))
+                         (esc) "'")]
+    )
+  )
+
+(define (onleaf leaf)
+  (format #f "~a" leaf))
+
+(define (parse-tree tree-callback leaf-callback)
+  (match-lambda
+    [(tag ('@ args ...) body ...)
+     (tree-callback tag body args)]
+    [(tag body ...)
+     (tree-callback tag body)
+     ]
+    [() ""]
+    [(any ...) (map leaf-callback any)]
+    [any (leaf-callback any)]))
+
+
+(define-public (sxml->ansi-text tree)
+  ((parse-tree ontree onleaf) tree))
diff --git a/module/text/numbers.scm b/module/text/numbers.scm
new file mode 100644
index 00000000..c590c188
--- /dev/null
+++ b/module/text/numbers.scm
@@ -0,0 +1,155 @@
+(define-module (text numbers)
+  :use-module (util))
+
+;; only used in number->string-cardinal
+(define (large-prefix e)
+  (cond
+   [(<=  6 e 11) "m"]
+   [(<= 12 e 17) "b"]
+   [(<= 18 e 23) "tr"]
+   [(<= 24 e 29) "kvadr"]
+   [(<= 30 e 35) "kvint"]
+   [(<= 36 e 41) "sext"]
+   [(<= 42 e 47) "sept"]
+   [(<= 48 e 53) "okt"]
+   [(<= 54 e 59) "non"]
+   [(<= 60 e 65) "dec"]
+   ))
+
+(define-public (number->string-cardinal n)
+  (cond [(< n 0) (string-append "minus " (number->string-cardinal (- n)))]
+        [(= n 0) "noll"]
+        [(= n 1) "ett"]
+        [(= n 2) "två"]
+        [(= n 3) "tre"]
+        [(= n 4) "fyra"]
+        [(= n 5) "fem"]
+        [(= n 6) "sex"]
+        [(= n 7) "sju"]
+        [(= n 8) "åtta"]
+        [(= n 9) "nio"]
+        [(= n 10) "tio"]
+        [(= n 11) "elva"]
+        [(= n 12) "tolv"]
+        [(= n 13) "tretton"]
+        [(= n 14) "fjorton"]
+        [(= n 15) "femton"]
+        [(= n 15) "sexton"]
+        [(= n 17) "sjutton"]
+        [(= n 18) "arton"]
+        [(= n 19) "nitton"]
+        [(= n 20) "tjugo"]
+        [(<= 21 n 29) (format #f "tjugo~a" (number->string-cardinal
+                                           (- n 20)))]
+        [(<= 30 n 79) (let* ((big small (floor/ n 10)))
+                       (format #f "~atio~a"
+                               (number->string-cardinal big)
+                               (number->string-cardinal small)))]
+        [(= n 80) "åttio"]
+        [(<= 81 n 89) (let* ((_ small (floor/ n 10)))
+                       (format #f "åttio~a"
+                               (number->string-cardinal small)))]
+        [(= n 90) "nittio"]
+        [(<= 91 n 99) (let* ((_ small (floor/ n 10)))
+                       (format #f "nittio~a"
+                               (number->string-cardinal small)))] 
+        [(= n 100) "hundra"]
+        [(< 100 n 200) (let* ((_ small (floor/ n 100)))
+                         (format #f "hundra~a"
+                                 (number->string-cardinal small)))]
+        [(= n 200) "tvåhundra"]
+        [(< 200 n 1000) (let* ((big small (floor/ n 100)))
+                          (format #f "~ahundra~a"
+                                  (number->string-cardinal big)
+                                  (number->string-cardinal small)))]
+        [(<= 1000 n 999999)
+         (let* ((big small (floor/ n 1000)))
+           (format #f "~a tusen ~a~a"
+                   (number->string-cardinal big)
+                   (if (<= 100 small 199)
+                       "ett " "")
+                   (number->string-cardinal small)))]
+        [(<= #e10e6 n (1- #e10e66))
+         (let* ((e (inexact->exact (floor (log10 n))))
+                (big small (floor/ n #e1e6)))
+           (if (zero? big)
+               (number->string-cardinal small)
+               (format #f "~a ~a~a~a ~a"
+                       (number->string-cardinal big)
+                       (large-prefix e)
+                       (if (even? (floor-quotient e 3))
+                           "iljon" "iljard")
+                       (if (= 1 big)
+                           "" "er")
+                       (number->string-cardinal small)
+                       )))]
+        [else
+         ;; I give up, don't have larger numbers that that!
+         (string-append "det stora talet "
+                        (number->string n))]))
+
+(define-public (number->string-ordinal n)
+  (cond [(>= -3 n) (format #f "~a sista" (number->string-ordinal (- n)))]
+        [(= -2 n) "näst sista"]
+        [(= -1 n) "sista"]
+        [(= 0 n) "nollte"]              ;
+        [(= 1 n) "förste"]
+        [(= 2 n) "andre"]
+        [(= 3 n) "tredje"]
+        [(= 4 n) "fjärde"]
+        [(= 5 n) "femte"]
+        [(= 6 n) "sjätte"]
+        [(= 7 n) "sjunde"]
+        [(= 8 n) "åttonde"]
+        [(= 9 n) "nionde"]
+        [(= 10 n) "tionde"]
+        [(= 11 n) "elfte"]
+        [(= 12 n) "tolfte"]
+        [(= 13 n) "trettonde"]
+        [(= 14 n) "fjortonde"]
+        [(= 15 n) "femtonde"]
+        [(= 16 n) "sextonde"]
+        [(= 17 n) "sjuttonde"]
+        [(= 18 n) "artonde"]
+        [(= 19 n) "nitonde"]
+        [(<= 20 n 29) (format #f "tjugo~a"
+                             (if (= 20 n)
+                                 "nde"
+                                 (number->string-ordinal (- n 20))))]
+        [(<= 30 n 99)
+         (let* ((big small (floor/ n 10)))
+           (format #f "~atio~a"
+                   (case big
+                     [(8) "åt"]
+                     [(9) "ni"]
+                     [else (number->string-cardinal big)])
+                   (if (zero? (modulo small 10))
+                       "nde"
+                       (number->string-ordinal small))))]
+        [(= n 100) "hundrade"]
+        [(= n 1000) "tusende"]
+        [else
+         (let* ((big small (floor/ n 100)))
+           (string-append (number->string-cardinal (* big 100))
+                          (if (zero? small)
+                              "de"
+                              (number->string-ordinal small))))]))
+
+;; (each-string 1) ; => "varje"
+;; (each-string 2) ; => "varannan"
+;; (each-string 3) ; => "var tredje"
+;; (each-string 3 #t) ; => "vart tredje"
+(define*-public (each-string count optional: neutrum)
+  (string-flatten
+   (cons
+    "var"
+    (case count
+      [(1) '("je")]
+      [(2)
+       ;; varannan månad
+       ;; vartannat år
+       (list (if neutrum "t")
+             "anna"
+             (if neutrum "t" "n"))]
+      [else (list (if neutrum "t") " "
+                  (number->string-ordinal count))]))))
diff --git a/module/text/util.scm b/module/text/util.scm
new file mode 100644
index 00000000..eda2df98
--- /dev/null
+++ b/module/text/util.scm
@@ -0,0 +1,45 @@
+(define-module (text util)
+  :use-module (util))
+
+(define-public (words str) (string-split str #\space))
+(define-public (unwords list) (string-join list " " 'infix))
+
+(define-public (lines str) (string-split str #\newline))
+(define-public (unlines list) (string-join list "\n" 'infix))
+
+;; Alternative string-length whith counts ANSI escapes as 0-length.
+;; NOTE Some way to opt in and out of different features would be nice.
+(define-public (true-string-length word)
+  (let loop ((chars (string->list word)))
+    (if (null? chars)
+        0
+        (let ((char (car chars)))
+          (if (eqv? #\escape char)
+              (loop (cdr (memv #\m chars)))
+              (1+ (loop (cdr chars))))))))
+
+(define*-public (true-string-pad str len optional: (chr #\space))
+  (let ((strlen (true-string-length str)))
+    (if (> strlen len)
+        str
+        (string-append (make-string (- len strlen) chr)
+                       str))))
+
+
+(define-public (trim-to-width str len)
+  (let ((trimmed (string-pad-right str len)))
+    (if (< (string-length trimmed)
+           (string-length str))
+        (string-append (string-drop-right trimmed 1)
+                       "…")
+        trimmed)))
+
+;; TODO more options for infix strings
+(define*-public (add-enumeration-punctuation
+                 list optional: (final-delim "&"))
+  (cond [(null? list) ""]
+        [(= 1 (length list)) (car list)]
+        [else
+         (let* (((tail . rest) (reverse list)))
+           (reverse (cons* tail " " final-delim " "
+                           (intersperce ", " rest))))]))
diff --git a/module/util/options.scm b/module/util/options.scm
index 17d77006..41514a8f 100644
--- a/module/util/options.scm
+++ b/module/util/options.scm
@@ -1,9 +1,7 @@
 (define-module (util options)
   :use-module (util)
-  :use-module (ice-9 match)
-  :use-module (ice-9 pretty-print)
   :use-module (srfi srfi-1)
-  :use-module ((output text) :select (flow-text)))
+)
 
 ;; option-assoc → getopt-valid option-assoc
 (define-public (getopt-opt options)
@@ -41,119 +39,8 @@
                        `((blockquote ,@it)
                          (br)))))))
 
-(define (esc . effect)
-  (format #f "\x1b[~am"
-          (if (null? effect)
-              ""
-              (case (car effect)
-                [(bold) 1]
-                [(italic) 3]
-                [(invert) 7]
-                [else 4]))))
+(use-modules (text markup))
 
-(use-modules (texinfo string-utils))
-
-(define (add-attributes args)
-  (match-lambda
-    [(name ('@ tagargs ...) body ...)
-     `(,name (@ ,@(assq-limit (assq-merge tagargs args)))
-             ,@body)]
-    [(name body ...)
-     `(,name (@ ,@args) ,@body)]
-    [nonlist nonlist]))
-
-(define* (true-string-pad str len optional: (chr #\space))
-  (let ((strlen ((@@ (output text) true-string-length) str)))
-    (if (> strlen len)
-        str
-        (string-append (make-string (- len strlen) chr) str))))
-
-(define (get-attr args key default)
-  (aif (assoc-ref args key)
-       (car it) default))
-
-;; NOTE width is hard coded to 70 chars
-(define* (ontree tag body optional: (args '()))
-  (case tag
-    [(*TOP* group block) (string-concatenate
-                          (map (compose sxml->ansi-text (add-attributes args))
-                               body))]
-    [(header) (sxml->ansi-text `(group (center (@ ,@args) (b ,@body)) (br)))]
-    [(center) (center-string (string-concatenate (map sxml->ansi-text body))
-                             (get-attr args 'width 70))]
-    [(p) (string-append (string-join (flow-text (string-concatenate (map sxml->ansi-text body))
-                                                width: (get-attr args 'width 70))
-                                     "\n")
-                        (if (assoc-ref args 'inline) "" "\n\n")
-                        )]
-    [(b) (string-append (esc 'bold) (string-concatenate (map sxml->ansi-text body)) (esc))]
-    [(i em) (string-append (esc 'italic) (string-concatenate (map sxml->ansi-text body)) (esc))]
-    ;; NOOP, but for future use.
-    [(code) (string-concatenate (map sxml->ansi-text body))]
-    [(blockquote) (string-concatenate
-                   (map (lambda (line) (sxml->ansi-text `(group (ws (@ (minwidth 4))) ,line (br))))
-                        (flow-text
-                         (string-concatenate (map sxml->ansi-text body))
-                         width: 66)))]
-    [(ws) (make-string  (aif (assoc-ref args 'minwidth)
-                             (car it) 1)
-                        #\space)]
-    [(br) "\n"]
-    [(hr) (string-append "     " (make-string 60 #\_) "     \n")]
-    [(dl)
-     (let* ((dts dds (partition (lambda (x) (eq? 'dt (car x))) body)))
-       (let* ((dts* (map sxml->ansi-text dts))
-              (m (if (null? dts*) 0 (apply max (map (@@ (output text) true-string-length) dts*)))))
-         (string-concatenate
-          (map (lambda (dt dd)
-                 (let ((dds (string-split dd #\newline)))
-                   (string-concatenate
-                    (map (lambda (left right)
-                           (string-append (true-string-pad left m) " │ " right "\n"))
-                         (cons dt (map (const "") (iota (1- (length dds)))))
-                         dds))))
-               dts*
-               (map (compose sxml->ansi-text (add-attributes `((width ,(- 70 m 5)))))
-                    dds)))))]
-    [(dt) (string-concatenate (map (compose sxml->ansi-text (add-attributes args))
-                                   body))]
-    [(dd)
-     (string-concatenate
-      (map (compose sxml->ansi-text (add-attributes args))
-           body))]
-
-    [(scheme)
-     (string-concatenate
-      (map (lambda (form)
-             (with-output-to-string
-               (lambda () (pretty-print form width: (aif (assoc-ref args 'width) (car it) 70)))))
-           body))]
-
-    [else (string-append (esc 'bold) "??"
-                         "`"
-                         (esc 'invert)
-                         (string-concatenate (map sxml->ansi-text body))
-                         (esc) "'")]
-    )
-  )
-
-(define (onleaf leaf)
-  (format #f "~a" leaf))
-
-(define (parse-tree tree-callback leaf-callback)
-  (match-lambda
-    [(tag ('@ args ...) body ...)
-     (tree-callback tag body args)]
-    [(tag body ...)
-     (tree-callback tag body)
-     ]
-    [() ""]
-    [(any ...) (map leaf-callback any)]
-    [any (leaf-callback any)]))
-
-
-(define-public (sxml->ansi-text tree)
-  ((parse-tree ontree onleaf) tree))
 
 (define-public (format-arg-help options)
   (sxml->ansi-text (cons '*TOP* (map sxml->ansi-text (map fmt-help options)))))
diff --git a/module/vcomponent/recurrence/display.scm b/module/vcomponent/recurrence/display.scm
index c30a7344..dc9f61e8 100644
--- a/module/vcomponent/recurrence/display.scm
+++ b/module/vcomponent/recurrence/display.scm
@@ -6,9 +6,10 @@
 ;;; Code:
 
 (define-module (vcomponent recurrence display)
-  :use-module (vcomponent recurrence internal)
   :use-module (util)
-  :use-module (output text)
+  :use-module (vcomponent recurrence internal)
+  :use-module (text util)
+  :use-module (text numbers)
   :use-module ((datetime) :select (time))
   :use-module (datetime util)
   )
-- 
cgit v1.2.3