diff options
Diffstat (limited to 'module/text/markup.scm')
-rw-r--r-- | module/text/markup.scm | 63 |
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) |