giles
69defdc517
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
55 lines
2.5 KiB
Plaintext
55 lines
2.5 KiB
Plaintext
;; 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 := '<thead><tr>' , (headers inject: '' into: [:a :h | a , '<th>' , h htmlEscaped , '</th>']) , '</tr></thead>'. tbody := '<tbody>' , (rows inject: '' into: [:a :r | a , '<tr>' , (r inject: '' into: [:b :c | b , '<td>' , c htmlEscaped , '</td>']) , '</tr>']) , '</tbody>'. ^ '<table>' , thead , tbody , '</table>'")
|
|
(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))))
|