1 files changed, 60 insertions, 3 deletions
diff --git a/module/text/markup.scm b/module/text/markup.scm
index 84bf7f61..b4724838 100644
--- a/module/text/markup.scm
+++ b/module/text/markup.scm
@@ -5,7 +5,8 @@
   :use-module (ice-9 pretty-print)
   :use-module (text util)
   :use-module (text flow)
-  :use-module (texinfo string-utils))
+  :use-module (texinfo string-utils)
+  :use-module (vulgar color))
 
 
 (define (esc . effect)
@@ -31,9 +32,15 @@
     [nonlist nonlist]))
 
 
-(define (get-attr args key default)
+(define* (get-attr args key optional: default)
   (aif (assoc-ref args key)
-       (car it) default))
+       (car it)
+       (if default default
+           (error "~a required" key))))
+
+(define (box-top intersection line . lengths)
+  (reduce (lambda (str done) (string-append done (string intersection) str))
+          "" (map (lambda (len) (make-string len line)) lengths)))
 
 ;; NOTE Some tags can be given a `width' attribute. This is however not yet
 ;; fully supported.
@@ -42,6 +49,39 @@
     [(*TOP* group block) (string-concatenate
                           (map (compose sxml->ansi-text (add-attributes args))
                                body))]
+    [(table)
+     ;; TODO border option
+     (let* ((width-list (get-attr args 'widths))
+            (auto-count (count (lambda (e) (eq? '- e)) width-list))
+            (width (if (zero? auto-count)
+                       (apply + width-list)
+                       (get-attr args 'max-width)))
+            (auto-width (- (get-attr args 'max-width)
+                           (fold (lambda (item sum)
+                                   (if (eq? item '-) sum (+ item sum)))
+                                 0 width-list)))
+            (resolved-widths (map (lambda (w) (if (eq? w '-) auto-width w)) width-list)))
+       (string-append
+        (apply box-top #\┬ #\─ resolved-widths)
+        "\n"
+        (string-concatenate
+         (map (compose sxml->ansi-text (add-attributes
+                                        (acons 'widths (list resolved-widths)
+                                               args)))
+              body))
+
+        (apply box-top #\┴ #\─ resolved-widths)
+        "\n"))]
+    [(tr) ; table row
+     (string-append
+      (string-concatenate
+       (intersperce
+        "│"
+        (map (lambda (element width)
+               (trim-to-width (sxml->ansi-text element) width))
+             body
+             (get-attr args 'widths))))
+      "\n")]
     [(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))]
@@ -94,6 +134,23 @@
                 (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
+         (if (symbol? c)
+             (case c
+               ((grey gray) "\x1b[1;30m")
+               (else "\x1b[1:31m"))
+             (color-escape c)))
+
+       (string-concatenate `(,cesc
+                              ,@(intersperce cesc (map sxml->ansi-text body))
+                              ,STR-RESET)))]
+
     [else (string-append (esc 'bold) "??"
                          "`"
                          (esc 'invert)