;; 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! "CtHeading" "asSx" "asSx | t | t := level printString. ^ '(h' , t , ' ' , self inlineSx , ')'") (ct-def-method! "CtHeading" "asMarkdown:" "asMarkdown: nl | h i | h := ''. i := 0. [i < level] whileTrue: [h := h , '#'. i := i + 1]. ^ h , ' ' , self inlineMd") (ct-def-method! "CtHeading" "asText" "asText ^ self inlineText") (ct-def-method! "CtQuote" "asHTML" "asHTML ^ '
' , 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)))