;; content-on-sx — table block. ;; ;; CtTable holds `headers` (list of strings) and `rows` (list of string lists). ;; Self-contained: it answers asHTML/asSx/asText/asMarkdown: by folding rows and ;; cells, so it composes with the render boundary with no changes elsewhere. HTML ;; cells are htmlEscaped, SX cells sxEscaped (render.sx must be loaded). ;; ;; Requires (loaded by harness): block.sx, doc.sx, render.sx (escapers); ;; markdown.sx / text.sx for those formats. (define content-bootstrap-table! (fn () (begin (st-class-define! "CtTable" "CtBlock" (list "headers" "rows")) (ct-def-method! "CtTable" "headers" "headers ^ headers") (ct-def-method! "CtTable" "rows" "rows ^ rows") (ct-def-method! "CtTable" "type" "type ^ #table") (ct-def-method! "CtTable" "asHTML" "asHTML | thead tbody | thead := '' , (headers inject: '' into: [:a :h | a , '' , h htmlEscaped , '']) , ''. tbody := '' , (rows inject: '' into: [:a :r | a , '' , (r inject: '' into: [:b :c | b , '' , c htmlEscaped , '']) , '']) , ''. ^ '' , thead , tbody , '
'") (ct-def-method! "CtTable" "asSx" "asSx ^ '(table (thead (tr ' , (headers inject: '' into: [:a :h | a , '(th \"' , h sxEscaped , '\")']) , ')) (tbody ' , (rows inject: '' into: [:a :r | a , '(tr ' , (r inject: '' into: [:b :c | b , '(td \"' , c sxEscaped , '\")']) , ')']) , '))'") (ct-def-method! "CtTable" "asText" "asText ^ (rows inject: (headers inject: '' into: [:a :h | (a = '' ifTrue: [h] ifFalse: [a , ' ' , h])]) into: [:acc :r | acc , ' ' , (r inject: '' into: [:b :c | (b = '' ifTrue: [c] ifFalse: [b , ' ' , c])])])") (ct-def-method! "CtTable" "asMarkdown:" "asMarkdown: nl | head sep body | head := '|' , (headers inject: '' into: [:a :h | a , ' ' , h , ' |']). sep := '|' , (headers inject: '' into: [:a :h | a , ' --- |']). body := (rows inject: '' into: [:acc :r | acc , nl , '|' , (r inject: '' into: [:a :c | a , ' ' , c , ' |'])]). ^ head , nl , sep , body") true))) (define mk-table (fn (id headers rows) (st-iv-set! (st-iv-set! (st-iv-set! (st-make-instance "CtTable") "id" id) "headers" headers) "rows" rows))) (define table? (fn (b) (and (st-instance? b) (= (get b :class) "CtTable")))) (define table-headers (fn (tb) (st-send tb "headers" (list)))) (define table-rows (fn (tb) (st-send tb "rows" (list))))