giles
2c1d8c8064
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
87 lines
3.6 KiB
Plaintext
87 lines
3.6 KiB
Plaintext
;; content-on-sx — render boundary.
|
|
;;
|
|
;; Rendering is a message, not a property switch: every block (and the document)
|
|
;; answers asHTML and asSx. The internal model carries no presentation — the
|
|
;; boundary format is chosen by which message you send. The document folds its
|
|
;; children's renderings, so (asHTML doc) / (asSx doc) are pure polymorphic
|
|
;; sends with no type dispatch in the SX layer.
|
|
;;
|
|
;; HTML escaping happens HERE, at the boundary: text and attribute values are
|
|
;; passed through String>>htmlEscaped (& < > "), so untrusted content cannot
|
|
;; break out of its element. asSx wire output is not yet string-escaped (next).
|
|
|
|
(define
|
|
content-bootstrap-render!
|
|
(fn
|
|
()
|
|
(begin
|
|
(ct-def-method!
|
|
"String"
|
|
"htmlEscaped"
|
|
"htmlEscaped | out i n c | out := ''. n := self size. i := 1. [i <= n] whileTrue: [c := self at: i. (c = $&) ifTrue: [out := out , '&'] ifFalse: [(c = $<) ifTrue: [out := out , '<'] ifFalse: [(c = $>) ifTrue: [out := out , '>'] ifFalse: [(c = $\") ifTrue: [out := out , '"'] ifFalse: [out := out , c asString]]]]. i := i + 1]. ^ out")
|
|
(ct-def-method!
|
|
"CtHeading"
|
|
"asHTML"
|
|
"asHTML | t | t := level printString. ^ '<h' , t , '>' , text htmlEscaped , '</h' , t , '>'")
|
|
(ct-def-method!
|
|
"CtText"
|
|
"asHTML"
|
|
"asHTML ^ '<p>' , text htmlEscaped , '</p>'")
|
|
(ct-def-method!
|
|
"CtCode"
|
|
"asHTML"
|
|
"asHTML ^ '<pre><code class=\"language-' , language htmlEscaped , '\">' , text htmlEscaped , '</code></pre>'")
|
|
(ct-def-method!
|
|
"CtQuote"
|
|
"asHTML"
|
|
"asHTML ^ '<blockquote>' , text htmlEscaped , '</blockquote>'")
|
|
(ct-def-method!
|
|
"CtImage"
|
|
"asHTML"
|
|
"asHTML ^ '<img src=\"' , src htmlEscaped , '\" alt=\"' , alt htmlEscaped , '\">'")
|
|
(ct-def-method!
|
|
"CtEmbed"
|
|
"asHTML"
|
|
"asHTML ^ '<iframe src=\"' , url htmlEscaped , '\"></iframe>'")
|
|
(ct-def-method! "CtDivider" "asHTML" "asHTML ^ '<hr>'")
|
|
(ct-def-method!
|
|
"CtList"
|
|
"asHTML"
|
|
"asHTML | tag | tag := ordered ifTrue: ['ol'] ifFalse: ['ul']. ^ '<' , tag , '>' , (items inject: '' into: [:a :x | a , '<li>' , x htmlEscaped , '</li>']) , '</' , tag , '>'")
|
|
(ct-def-method!
|
|
"CtDoc"
|
|
"asHTML"
|
|
"asHTML ^ blocks inject: '' into: [:a :b | a , (b asHTML)]")
|
|
(ct-def-method!
|
|
"CtHeading"
|
|
"asSx"
|
|
"asSx | t | t := level printString. ^ '(h' , t , ' \"' , text , '\")'")
|
|
(ct-def-method! "CtText" "asSx" "asSx ^ '(p \"' , text , '\")'")
|
|
(ct-def-method! "CtCode" "asSx" "asSx ^ '(pre (code \"' , text , '\"))'")
|
|
(ct-def-method! "CtQuote" "asSx" "asSx ^ '(blockquote \"' , text , '\")'")
|
|
(ct-def-method!
|
|
"CtImage"
|
|
"asSx"
|
|
"asSx ^ '(img :src \"' , src , '\" :alt \"' , alt , '\")'")
|
|
(ct-def-method! "CtEmbed" "asSx" "asSx ^ '(iframe :src \"' , url , '\")'")
|
|
(ct-def-method! "CtDivider" "asSx" "asSx ^ '(hr)'")
|
|
(ct-def-method!
|
|
"CtList"
|
|
"asSx"
|
|
"asSx | tag | tag := ordered ifTrue: ['ol'] ifFalse: ['ul']. ^ '(' , tag , ' ' , (items inject: '' into: [:a :x | a , '(li \"' , x , '\")']) , ')'")
|
|
(ct-def-method!
|
|
"CtDoc"
|
|
"asSx"
|
|
"asSx ^ '(article ' , (blocks inject: '' into: [:a :b | a , (b asSx)]) , ')'")
|
|
true)))
|
|
|
|
;; ── SX boundary API — pure message sends ──
|
|
(define asHTML (fn (node) (str (st-send node "asHTML" (list)))))
|
|
(define asSx (fn (node) (str (st-send node "asSx" (list)))))
|
|
|
|
;; readable aliases
|
|
(define render-html asHTML)
|
|
(define render-sx asSx)
|
|
(define block-html asHTML)
|
|
(define block-sx asSx)
|