;; content-on-sx — Phase 5: rich inline text (structured runs).
;;
;; A CtText's `text` ivar may be EITHER a plain string (backward compat) OR a
;; list of inline RUNS. A run is a 3-element list (text marks href):
;; text — a string
;; marks — a list of mark tokens, a subset of
;; :bold :italic :underline :strikethrough :code :subscript
;; :superscript :link (SX keywords evaluate to the strings the
;; Smalltalk renderer compares against; build them with keywords)
;; href — a string ("" when absent; the link target for a :link mark)
;;
;; Runs are a LIST, not a {:text :marks} dict, because rendering happens inside
;; the Smalltalk render methods (nested blocks dispatch asHTML/etc. via Smalltalk
;; message sends) and the Smalltalk-on-SX layer can iterate SX lists but cannot
;; read SX dict fields. Lists are Smalltalk-native, render under nesting, and
;; round-trip through data/wire for free.
;;
;; content-bootstrap-runs! OVERRIDES the render/markdown/text methods of CtText
;; and its subclasses (CtHeading/CtQuote rich; CtCode verbatim — runs render as
;; plain concatenated text) with run-aware versions that produce IDENTICAL output
;; for a plain-string body. Opt-in: call after the render/markdown/text
;; bootstraps; suites that don't call it are unaffected.
;;
;; Requires (loaded by harness): block.sx, render.sx, markdown.sx, text.sx.
;; ── SX-side run helpers ──
(define mk-run (fn (text marks href) (list text marks href)))
(define mk-run-plain (fn (text) (list text (list) "")))
(define run-text (fn (r) (nth r 0)))
(define run-marks (fn (r) (nth r 1)))
(define run-href (fn (r) (nth r 2)))
;; a CtText body is "rich" iff it is a runs list (vs a plain string)
(define runs? (fn (v) (list? v)))
;; build a CtText whose body is a list of runs
(define
mk-rich-text
(fn (id runs) (st-iv-set! (mk-text id "") "text" runs)))
(define
content-bootstrap-runs!
(fn
()
(begin
(ct-def-method!
"CtText"
"runHtml:"
"runHtml: run | frag marks href | frag := (run at: 1) htmlEscaped. marks := run at: 2. href := run at: 3. marks do: [:m | (m = 'bold') ifTrue: [frag := '' , frag , '']. (m = 'italic') ifTrue: [frag := '' , frag , '']. (m = 'underline') ifTrue: [frag := '' , frag , '']. (m = 'strikethrough') ifTrue: [frag := '' , frag , '']. (m = 'code') ifTrue: [frag := '' , frag , '']. (m = 'subscript') ifTrue: [frag := '' , frag , '']. (m = 'superscript') ifTrue: [frag := '' , frag , '']. (m = 'link') ifTrue: [frag := '' , frag , '']]. ^ frag")
(ct-def-method!
"CtText"
"runSx:"
"runSx: run | frag marks href | frag := '\"' , (run at: 1) sxEscaped , '\"'. marks := run at: 2. href := run at: 3. marks do: [:m | (m = 'bold') ifTrue: [frag := '(strong ' , frag , ')']. (m = 'italic') ifTrue: [frag := '(em ' , frag , ')']. (m = 'underline') ifTrue: [frag := '(u ' , frag , ')']. (m = 'strikethrough') ifTrue: [frag := '(s ' , frag , ')']. (m = 'code') ifTrue: [frag := '(code ' , frag , ')']. (m = 'subscript') ifTrue: [frag := '(sub ' , frag , ')']. (m = 'superscript') ifTrue: [frag := '(sup ' , frag , ')']. (m = 'link') ifTrue: [frag := '(a :href \"' , href sxEscaped , '\" ' , frag , ')']]. ^ frag")
(ct-def-method!
"CtText"
"runMd:"
"runMd: run | frag marks href | frag := (run at: 1). marks := run at: 2. href := run at: 3. marks do: [:m | (m = 'bold') ifTrue: [frag := '**' , frag , '**']. (m = 'italic') ifTrue: [frag := '_' , frag , '_']. (m = 'strikethrough') ifTrue: [frag := '~~' , frag , '~~']. (m = 'code') ifTrue: [frag := '`' , frag , '`']. (m = 'underline') ifTrue: [frag := '' , frag , '']. (m = 'subscript') ifTrue: [frag := '' , frag , '']. (m = 'superscript') ifTrue: [frag := '' , frag , '']. (m = 'link') ifTrue: [frag := '[' , frag , '](' , href , ')']]. ^ frag")
(ct-def-method!
"CtText"
"inlineHtml"
"inlineHtml | out | (text class name = 'String') ifTrue: [^ text htmlEscaped]. out := ''. text do: [:run | out := out , (self runHtml: run)]. ^ out")
(ct-def-method!
"CtText"
"inlineSx"
"inlineSx | out | (text class name = 'String') ifTrue: [^ '\"' , text sxEscaped , '\"']. out := ''. text do: [:run | out := (out = '' ifTrue: [self runSx: run] ifFalse: [out , ' ' , (self runSx: run)])]. ^ out")
(ct-def-method!
"CtText"
"inlineMd"
"inlineMd | out | (text class name = 'String') ifTrue: [^ text]. out := ''. text do: [:run | out := out , (self runMd: run)]. ^ out")
(ct-def-method!
"CtText"
"inlineText"
"inlineText | out | (text class name = 'String') ifTrue: [^ text]. out := ''. text do: [:run | out := out , (run at: 1)]. ^ out")
(ct-def-method!
"CtText"
"asHTML"
"asHTML ^ '
' , self inlineHtml , '
'") (ct-def-method! "CtText" "asSx" "asSx ^ '(p ' , self inlineSx , ')'") (ct-def-method! "CtText" "asMarkdown:" "asMarkdown: nl ^ self inlineMd") (ct-def-method! "CtText" "asText" "asText ^ self inlineText") (ct-def-method! "CtHeading" "asHTML" "asHTML | t | t := level printString. ^ '' , self inlineHtml , ''") (ct-def-method! "CtQuote" "asSx" "asSx ^ '(blockquote ' , self inlineSx , ')'") (ct-def-method! "CtQuote" "asMarkdown:" "asMarkdown: nl ^ '> ' , self inlineMd") (ct-def-method! "CtQuote" "asText" "asText ^ self inlineText") (ct-def-method! "CtCode" "asHTML" "asHTML ^ '
' , self inlineText htmlEscaped , ''")
(ct-def-method!
"CtCode"
"asSx"
"asSx ^ '(pre (code \"' , self inlineText sxEscaped , '\"))'")
(ct-def-method!
"CtCode"
"asMarkdown:"
"asMarkdown: nl ^ '```' , language , nl , self inlineText , nl , '```'")
(ct-def-method! "CtCode" "asText" "asText ^ self inlineText")
true)))