Add hack to get tables to render correctly.term

Made <color/> return a list of strings, and made <tr/> handle that
specific case. This allows the truncate to width method to only handle
the actuall letters, and to keep the terminal escapes before and after.

But as the TODO in the commit notes, this isn't sustainable. I probably
want to defer the rendering step to later, and instead transform the
markup tree into a processing tree, taging up each element with prefered
attributes, and a width.

1 files changed, 33 insertions, 8 deletions

diff --git a/module/text/markup.scm b/module/text/markup.scm
index b4724838..286494a6 100644
--- a/module/text/markup.scm
+++ b/module/text/markup.scm
@@ -45,6 +45,15 @@
 ;; NOTE Some tags can be given a `width' attribute. This is however not yet
 ;; fully supported.
 (define* (ontree tag body optional: (args '()))
+
+  ;; NOTE The attribute @style should preferably be supported.
+  ;; My idea for implementing it is to inject some style information
+  ;; where needed. Something like the following code, with matching
+  ;; reset code below the main case.
+  ;; (case (get-attr args 'style #f)
+  ;;   ((invert) "\x1b[7m")
+  ;;   (else ""))
+
   (case tag
     [(*TOP* group block) (string-concatenate
                           (map (compose sxml->ansi-text (add-attributes args))
@@ -78,7 +87,21 @@
        (intersperce
         "│"
         (map (lambda (element width)
-               (trim-to-width (sxml->ansi-text element) width))
+               (define subelems (sxml->ansi-text element))
+               (if (not (list? subelems))
+                   (trim-to-width subelems width)
+                   (let loop ((rem subelems)
+                              (w 0))
+                     (cond [(null? rem)
+                            (if (< w width)
+                                (make-string (- width w) #\space)
+                                "")]
+                           [(< width (+ w (true-string-length (car rem))))
+                            (trim-to-width (car rem) (- width w))]
+                           [else
+                            (string-append (car rem)
+                                           (loop (cdr rem)
+                                                 (+ w (true-string-length (car rem)))))]))))
              body
              (get-attr args 'widths))))
       "\n")]
@@ -119,8 +142,10 @@
                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))
@@ -134,10 +159,6 @@
                 (lambda () (pretty-print form width: (aif (assoc-ref args 'width) (car it) 70))))))
            body))]
 
-    [(invert)
-     (string-append
-      "\x1b[7m" (string-concatenate (map sxml->ansi-text body)) STR-RESET)]
-
     [(color)
      (let ((c (get-attr args 'c)))
        (define cesc
@@ -147,9 +168,13 @@
                (else "\x1b[1:31m"))
              (color-escape c)))
 
-       (string-concatenate `(,cesc
-                              ,@(intersperce cesc (map sxml->ansi-text body))
-                              ,STR-RESET)))]
+       ;; TODO Here we return multiple elements, to allow a parent to only
+       ;; truncate the middle string (since it's a BAD idea to remove the
+       ;; STR-RESET tail). This however isn't supported by the rest of the
+       ;; formating system. Something thereby needs to be rewordked.
+       (list cesc
+             (string-concatenate (intersperce cesc (map sxml->ansi-text body)))
+             STR-RESET))]
 
     [else (string-append (esc 'bold) "??"
                          "`"