rose-ash/lib/content/runs.sx

;; 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 := '<strong>' , frag , '</strong>']. (m = 'italic') ifTrue: [frag := '<em>' , frag , '</em>']. (m = 'underline') ifTrue: [frag := '<u>' , frag , '</u>']. (m = 'strikethrough') ifTrue: [frag := '<s>' , frag , '</s>']. (m = 'code') ifTrue: [frag := '<code>' , frag , '</code>']. (m = 'subscript') ifTrue: [frag := '<sub>' , frag , '</sub>']. (m = 'superscript') ifTrue: [frag := '<sup>' , frag , '</sup>']. (m = 'link') ifTrue: [frag := '<a href=\"' , href htmlEscaped , '\">' , frag , '</a>']]. ^ 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 := '<u>' , frag , '</u>']. (m = 'subscript') ifTrue: [frag := '<sub>' , frag , '</sub>']. (m = 'superscript') ifTrue: [frag := '<sup>' , frag , '</sup>']. (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 ^ '<p>' , self inlineHtml , '</p>'")
      (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. ^ '<h' , t , '>' , self inlineHtml , '</h' , t , '>'")
      (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 ^ '<blockquote>' , self inlineHtml , '</blockquote>'")
      (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 ^ '<pre><code class=\"language-' , language htmlEscaped , '\">' , self inlineText htmlEscaped , '</code></pre>'")
      (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)))