diff options
| -rw-r--r-- | module/text/markup.scm | 41 |
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) "??" "`" |