;; 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 , ' | ']) , '
']) , ''. ^ ''")
(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))))