content: Phase 5 — rich inline text via structured runs (861/861)

CtText.text may be a list of runs (text marks href); CtHeading/CtQuote rich,
CtCode verbatim. New runs.sx overrides render/markdown/text methods (byte-
identical for plain strings, opt-in). 4 modes: HTML tags / markdown / nested
SX / plain asText (drift-proof). find-replace per-run marks-preserving;
search across run boundaries; CRDT block-granularity LWW; data+wire round-trip.
Runs are a Smalltalk-renderable list (not a dict — substrate can't read dict
fields under nested render dispatch). +36 tests (44 suites). Phase 6 (char-
level inline CRDT) recorded as future.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>

lib/content/anchor.sx

@@ -0,0 +1,51 @@
+;; content-on-sx — anchored-heading HTML render.
+;;
+;; Like asHTML, but headings carry an id attribute (the block id), so the TOC's
+;; #id links resolve. A separate render so the plain asHTML stays unchanged.
+;; Tree-aware (sections recurse); other blocks use their normal asHTML.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx, render.sx (asHTML +
+;; htmlEscaped).
+
+(define
+  anch-section?
+  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
+(define anch-esc (fn (s) (str (st-send s "htmlEscaped" (list)))))
+
+(define
+  anchor-block
+  (fn
+    (b)
+    (cond
+      ((= (blk-type b) "heading")
+        (let
+          ((l (str (blk-get b "level"))) (id (blk-id b)))
+          (str
+            "<h"
+            l
+            " id=\""
+            id
+            "\">"
+            (anch-esc (str (blk-get b "text")))
+            "</h"
+            l
+            ">")))
+      ((anch-section? b)
+        (let
+          ((ch (st-iv-get b "children")))
+          (str
+            "<section>"
+            (anchor-blocks (if (list? ch) ch (list)))
+            "</section>")))
+      (else (str (st-send b "asHTML" (list)))))))
+
+(define
+  anchor-blocks
+  (fn
+    (blocks)
+    (if
+      (= (len blocks) 0)
+      ""
+      (str (anchor-block (first blocks)) (anchor-blocks (rest blocks))))))
+
+(define content/html-anchored (fn (doc) (anchor-blocks (doc-blocks doc))))

lib/content/api.sx

@@ -0,0 +1,72 @@
+;; content-on-sx — public API facade.
+;;
+;; The stable surface other code calls. Composes block + doc + render. Document
+;; values are immutable; every edit returns a new document, so callers hold
+;; explicit versions (the persist op log in Phase 2 becomes the source of truth).
+;;
+;; Requires (loaded by the harness): block.sx, doc.sx, render.sx and a base
+;; Smalltalk class table (st-bootstrap-classes!).
+
+;; Register the content class hierarchy + render methods. Caller bootstraps the
+;; base Smalltalk classes first; this only adds content classes (idempotent).
+(define
+  content/bootstrap!
+  (fn
+    ()
+    (begin
+      (content-bootstrap-blocks!)
+      (content-bootstrap-doc!)
+      (content-bootstrap-render!)
+      true)))
+
+;; ── documents ──
+(define content/new doc-new)
+(define content/empty doc-empty)
+(define content/append doc-append)
+(define content/blocks doc-blocks)
+(define content/count doc-count)
+;; find / has? are TREE-WIDE by id (descend into sections) — so the facade reads
+;; back any block content/edit can update or delete. content/find-top / has-top?
+;; keep the top-level-only lookup for callers that mean the ordered sequence.
+(define content/find doc-find-deep)
+(define content/has? doc-has-deep?)
+(define content/find-top doc-find)
+(define content/has-top? doc-has?)
+(define content/ids doc-ids)
+(define content/types doc-types)
+
+;; ── blocks ──
+(define content/block mk-block)
+
+;; ── edit ops (data payload) ──
+(define content/insert op-insert)
+(define content/update op-update)
+(define content/move op-move)
+(define content/delete op-delete)
+
+(define content/op? (fn (x) (and (dict? x) (has-key? x :op))))
+
+;; edit — apply one op or a stream of ops; returns a new document.
+(define
+  content/edit
+  (fn
+    (doc ops)
+    (if (content/op? ops) (doc-apply doc ops) (doc-apply-all doc ops))))
+
+;; ── render boundary ──
+;; fmt is "html"/"sx"/"md"/"text" (or the matching keyword). "md" needs
+;; markdown.sx loaded; "text" needs text.sx loaded.
+(define
+  content/render
+  (fn
+    (doc fmt)
+    (cond
+      ((= fmt "html") (asHTML doc))
+      ((= fmt "sx") (asSx doc))
+      ((= fmt "md") (asMarkdown doc))
+      ((= fmt "markdown") (asMarkdown doc))
+      ((= fmt "text") (asText doc))
+      (else (error (str "unknown render format: " fmt))))))
+
+(define content/html asHTML)
+(define content/sx asSx)

lib/content/block-path.sx

@@ -0,0 +1,45 @@
+;; content-on-sx — locate a block in the tree (ancestor section path).
+;;
+;; The read-side companion to doc-find-deep (which returns the block) and the
+;; move/reparent ops (which relocate it): content/block-path returns the list of
+;; ancestor section ids, root-first, leading to a block id — i.e. where the
+;; block sits in the tree. A top-level block has an empty path; a block one
+;; section deep has a one-element path; a missing id returns nil (distinct from
+;; the empty-list path of a present top-level block). content/block-depth is the
+;; path length (0 = top level, -1 = absent). Useful for breadcrumbs and for
+;; scoping an edit to a block's enclosing section. Pure traversal; descends into
+;; any block carrying a children list, like the rest of the tree helpers.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx.
+
+(define
+  bp-in-blocks
+  (fn
+    (blocks id trail)
+    (if
+      (= (len blocks) 0)
+      nil
+      (let
+        ((b (first blocks)))
+        (if
+          (= (blk-id b) id)
+          trail
+          (let
+            ((ch (st-iv-get b "children")))
+            (let
+              ((found (if (list? ch) (bp-in-blocks ch id (append trail (list (blk-id b)))) nil)))
+              (if (= found nil) (bp-in-blocks (rest blocks) id trail) found))))))))
+
+;; ancestor section ids (root-first) for `id`, or nil if the block is absent.
+(define
+  content/block-path
+  (fn (doc id) (bp-in-blocks (doc-blocks doc) id (list))))
+
+;; depth of `id`: 0 at top level, n nested n sections deep, -1 if absent.
+(define
+  content/block-depth
+  (fn
+    (doc id)
+    (let
+      ((p (content/block-path doc id)))
+      (if (= p nil) -1 (len p)))))

lib/content/block.sx

@@ -0,0 +1,171 @@
+;; content-on-sx — typed block objects on Smalltalk-on-SX.
+;;
+;; A block is a Smalltalk instance. Behaviour (type tag, later render) is a
+;; message, not a property switch. Fields are immutable: blk-set / mk-* build a
+;; fresh instance via the functional st-iv-set!, so old versions are never
+;; clobbered (history-safe for the persist op log and CRDT merge).
+;;
+;; Hierarchy:
+;;   CtBlock (id)
+;;     CtText (text)
+;;       CtHeading (level)
+;;       CtCode (language)
+;;       CtQuote (cite)
+;;     CtImage (src alt)
+;;     CtEmbed (url provider)
+;;     CtDivider
+;;     CtList (ordered items)
+;; Plus self-contained blocks registered by their own files: CtSection,
+;; CtTable, CtCallout, CtMedia. ct-class-for-type maps every tag (so mk-block,
+;; content/from-data and CRDT materialise build them uniformly); the classes
+;; themselves are registered by content-bootstrap-section!/table!/callout!/media!.
+
+(define
+  ct-def-method!
+  (fn (cls sel src) (st-class-add-method! cls sel (st-parse-method src))))
+
+;; Register the block hierarchy in the Smalltalk class table. Call AFTER
+;; st-bootstrap-classes! (which resets the table). Idempotent.
+(define
+  content-bootstrap-blocks!
+  (fn
+    ()
+    (begin
+      (st-class-define! "CtBlock" "Object" (list "id"))
+      (ct-def-method! "CtBlock" "id" "id ^ id")
+      (ct-def-method! "CtBlock" "type" "type ^ #block")
+      (ct-def-method! "CtBlock" "isBlock" "isBlock ^ true")
+      (st-class-define! "CtText" "CtBlock" (list "text"))
+      (ct-def-method! "CtText" "text" "text ^ text")
+      (ct-def-method! "CtText" "type" "type ^ #text")
+      (st-class-define! "CtHeading" "CtText" (list "level"))
+      (ct-def-method! "CtHeading" "level" "level ^ level")
+      (ct-def-method! "CtHeading" "type" "type ^ #heading")
+      (st-class-define! "CtCode" "CtText" (list "language"))
+      (ct-def-method! "CtCode" "language" "language ^ language")
+      (ct-def-method! "CtCode" "type" "type ^ #code")
+      (st-class-define! "CtQuote" "CtText" (list "cite"))
+      (ct-def-method! "CtQuote" "cite" "cite ^ cite")
+      (ct-def-method! "CtQuote" "type" "type ^ #quote")
+      (st-class-define! "CtImage" "CtBlock" (list "src" "alt"))
+      (ct-def-method! "CtImage" "src" "src ^ src")
+      (ct-def-method! "CtImage" "alt" "alt ^ alt")
+      (ct-def-method! "CtImage" "type" "type ^ #image")
+      (st-class-define! "CtEmbed" "CtBlock" (list "url" "provider"))
+      (ct-def-method! "CtEmbed" "url" "url ^ url")
+      (ct-def-method! "CtEmbed" "provider" "provider ^ provider")
+      (ct-def-method! "CtEmbed" "type" "type ^ #embed")
+      (st-class-define! "CtDivider" "CtBlock" (list))
+      (ct-def-method! "CtDivider" "type" "type ^ #divider")
+      (st-class-define! "CtList" "CtBlock" (list "ordered" "items"))
+      (ct-def-method! "CtList" "ordered" "ordered ^ ordered")
+      (ct-def-method! "CtList" "items" "items ^ items")
+      (ct-def-method! "CtList" "type" "type ^ #list")
+      true)))
+
+;; Apply (name value) pairs functionally onto a fresh instance.
+(define
+  ct-apply-fields
+  (fn
+    (inst pairs)
+    (if
+      (= (len pairs) 0)
+      inst
+      (ct-apply-fields
+        (st-iv-set!
+          inst
+          (first (first pairs))
+          (first (rest (first pairs))))
+        (rest pairs)))))
+
+(define
+  ct-class-for-type
+  (fn
+    (tag)
+    (cond
+      ((= tag "text") "CtText")
+      ((= tag "heading") "CtHeading")
+      ((= tag "code") "CtCode")
+      ((= tag "quote") "CtQuote")
+      ((= tag "image") "CtImage")
+      ((= tag "embed") "CtEmbed")
+      ((= tag "divider") "CtDivider")
+      ((= tag "list") "CtList")
+      ((= tag "section") "CtSection")
+      ((= tag "table") "CtTable")
+      ((= tag "callout") "CtCallout")
+      ((= tag "media") "CtMedia")
+      (else (error (str "unknown block type: " tag))))))
+
+;; Generic constructor — wire tag + id + (name value) field pairs.
+(define
+  mk-block
+  (fn
+    (type-tag id fields)
+    (ct-apply-fields
+      (st-iv-set! (st-make-instance (ct-class-for-type type-tag)) "id" id)
+      fields)))
+
+(define
+  mk-text
+  (fn (id text) (mk-block "text" id (list (list "text" text)))))
+
+(define
+  mk-heading
+  (fn
+    (id level text)
+    (mk-block "heading" id (list (list "level" level) (list "text" text)))))
+
+(define
+  mk-code
+  (fn
+    (id language text)
+    (mk-block
+      "code"
+      id
+      (list (list "language" language) (list "text" text)))))
+
+(define
+  mk-quote
+  (fn
+    (id cite text)
+    (mk-block "quote" id (list (list "cite" cite) (list "text" text)))))
+
+(define
+  mk-image
+  (fn
+    (id src alt)
+    (mk-block "image" id (list (list "src" src) (list "alt" alt)))))
+
+(define
+  mk-embed
+  (fn
+    (id url provider)
+    (mk-block "embed" id (list (list "url" url) (list "provider" provider)))))
+
+(define mk-divider (fn (id) (mk-block "divider" id (list))))
+
+(define
+  mk-list
+  (fn
+    (id ordered items)
+    (mk-block
+      "list"
+      id
+      (list (list "ordered" ordered) (list "items" items)))))
+
+;; Accessors. blk-type / blk-id go through message dispatch (polymorphic);
+;; blk-get reads any ivar directly; blk-set is copy-on-write.
+(define blk-id (fn (b) (st-send b "id" (list))))
+(define blk-type (fn (b) (str (st-send b "type" (list)))))
+(define blk-send (fn (b sel) (st-send b sel (list))))
+(define blk-get (fn (b field) (st-iv-get b field)))
+(define blk-set (fn (b field val) (st-iv-set! b field val)))
+
+(define
+  block?
+  (fn
+    (v)
+    (and
+      (st-instance? v)
+      (st-class-inherits-from? (get v :class) "CtBlock"))))

lib/content/callout.sx

@@ -0,0 +1,49 @@
+;; content-on-sx — callout / admonition block.
+;;
+;; CtCallout holds a `kind` (note/warning/tip/…) and `text`. Self-contained: it
+;; answers asHTML/asSx/asText/asMarkdown: so it composes with the render boundary
+;; with no changes elsewhere. HTML text is htmlEscaped, SX text sxEscaped.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx, render.sx (escapers);
+;; markdown.sx / text.sx for those formats.
+
+(define
+  content-bootstrap-callout!
+  (fn
+    ()
+    (begin
+      (st-class-define! "CtCallout" "CtBlock" (list "kind" "text"))
+      (ct-def-method! "CtCallout" "kind" "kind ^ kind")
+      (ct-def-method! "CtCallout" "text" "text ^ text")
+      (ct-def-method! "CtCallout" "type" "type ^ #callout")
+      (ct-def-method!
+        "CtCallout"
+        "asHTML"
+        "asHTML ^ '<aside class=\"callout callout-' , kind htmlEscaped , '\">' , text htmlEscaped , '</aside>'")
+      (ct-def-method!
+        "CtCallout"
+        "asSx"
+        "asSx ^ '(aside :class \"callout callout-' , kind sxEscaped , '\" \"' , text sxEscaped , '\")'")
+      (ct-def-method! "CtCallout" "asText" "asText ^ text")
+      (ct-def-method!
+        "CtCallout"
+        "asMarkdown:"
+        "asMarkdown: nl ^ '> **' , kind , ':** ' , text")
+      true)))
+
+(define
+  mk-callout
+  (fn
+    (id kind text)
+    (st-iv-set!
+      (st-iv-set!
+        (st-iv-set! (st-make-instance "CtCallout") "id" id)
+        "kind"
+        kind)
+      "text"
+      text)))
+
+(define
+  callout?
+  (fn (b) (and (st-instance? b) (= (get b :class) "CtCallout"))))
+(define callout-kind (fn (b) (st-send b "kind" (list))))

lib/content/clone.sx

@@ -0,0 +1,34 @@
+;; content-on-sx — block id remapping / clone.
+;;
+;; Deep-rewrite every block id in the tree (descending into sections) by applying
+;; a function. Enables collision-free composition: prefix one document's ids
+;; before concatenating it with another. Immutable; content is unchanged, only
+;; ids.
+;;
+;; Requires (loaded by harness): doc.sx, section.sx (section? /
+;; section-children / section-with-children).
+
+(define
+  block-remap-id
+  (fn
+    (b f)
+    (let
+      ((nb (blk-set b "id" (f (blk-id b)))))
+      (if
+        (section? nb)
+        (section-with-children
+          nb
+          (map (fn (c) (block-remap-id c f)) (section-children nb)))
+        nb))))
+
+(define
+  content/remap-ids
+  (fn
+    (doc f)
+    (doc-with-blocks
+      doc
+      (map (fn (b) (block-remap-id b f)) (doc-blocks doc)))))
+
+(define
+  content/prefix-ids
+  (fn (doc prefix) (content/remap-ids doc (fn (id) (str prefix id)))))

lib/content/compose.sx

@@ -0,0 +1,42 @@
+;; content-on-sx — document composition.
+;;
+;; Combine documents (header + body + footer, templates, partials) into a new
+;; document. The result keeps the FIRST document's id and metadata; blocks are
+;; concatenated. Immutable — inputs are untouched. Block-id collisions across
+;; combined docs are the caller's concern (content/validate flags duplicates).
+;;
+;; Requires (loaded by harness): doc.sx.
+
+(define
+  content/concat
+  (fn (a b) (doc-with-blocks a (append (doc-blocks a) (doc-blocks b)))))
+
+(define
+  content/prepend
+  (fn (a b) (doc-with-blocks a (append (doc-blocks b) (doc-blocks a)))))
+
+(define
+  content/-concat-fold
+  (fn
+    (acc more)
+    (if
+      (= (len more) 0)
+      acc
+      (content/-concat-fold (content/concat acc (first more)) (rest more)))))
+
+(define
+  content/concat-all
+  (fn
+    (docs)
+    (if
+      (= (len docs) 0)
+      (doc-empty "merged")
+      (content/-concat-fold (first docs) (rest docs)))))
+
+;; wrap a document's blocks inside a single section (collapse to a subtree).
+;; Requires section.sx (mk-section) when used.
+(define
+  content/wrap-section
+  (fn
+    (doc section-id)
+    (doc-with-blocks doc (list (mk-section section-id (doc-blocks doc))))))

lib/content/conformance.sh

@@ -0,0 +1,161 @@
+#!/usr/bin/env bash
+# lib/content/conformance.sh — run content-on-sx suites, emit scoreboard.
+
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
+if [ ! -x "$SX_SERVER" ]; then
+  MAIN_ROOT=$(git worktree list | head -1 | awk '{print $1}')
+  if [ -x "$MAIN_ROOT/$SX_SERVER" ]; then
+    SX_SERVER="$MAIN_ROOT/$SX_SERVER"
+  else
+    echo "ERROR: sx_server.exe not found." >&2
+    exit 1
+  fi
+fi
+
+SUITES=(block doc render api meta page page-full markdown runs text section compose tree-edit move block-path clone query toc anchor outline flatten transform normalize find-replace stats summary index table callout media data wire validate sanitize store snapshot crdt crdt-tree crdt-blocks crdt-store sync md-import md-doc fed)
+
+OUT_JSON="lib/content/scoreboard.json"
+OUT_MD="lib/content/scoreboard.md"
+
+run_suite() {
+  local suite=$1
+  local file="lib/content/tests/${suite}.sx"
+  local TMP
+  TMP=$(mktemp)
+  cat > "$TMP" << EPOCHS
+(epoch 1)
+(load "lib/smalltalk/tokenizer.sx")
+(load "lib/smalltalk/parser.sx")
+(load "lib/guest/reflective/class-chain.sx")
+(load "lib/smalltalk/runtime.sx")
+(load "lib/guest/reflective/env.sx")
+(load "lib/smalltalk/eval.sx")
+(load "lib/persist/event.sx")
+(load "lib/persist/backend.sx")
+(load "lib/persist/log.sx")
+(load "lib/persist/kv.sx")
+(load "lib/persist/api.sx")
+(load "lib/content/block.sx")
+(load "lib/content/doc.sx")
+(load "lib/content/render.sx")
+(load "lib/content/api.sx")
+(load "lib/content/meta.sx")
+(load "lib/content/text.sx")
+(load "lib/content/section.sx")
+(load "lib/content/compose.sx")
+(load "lib/content/tree-edit.sx")
+(load "lib/content/move.sx")
+(load "lib/content/block-path.sx")
+(load "lib/content/clone.sx")
+(load "lib/content/query.sx")
+(load "lib/content/toc.sx")
+(load "lib/content/anchor.sx")
+(load "lib/content/outline.sx")
+(load "lib/content/flatten.sx")
+(load "lib/content/transform.sx")
+(load "lib/content/normalize.sx")
+(load "lib/content/find-replace.sx")
+(load "lib/content/stats.sx")
+(load "lib/content/summary.sx")
+(load "lib/content/index.sx")
+(load "lib/content/table.sx")
+(load "lib/content/callout.sx")
+(load "lib/content/media.sx")
+(load "lib/content/data.sx")
+(load "lib/content/wire.sx")
+(load "lib/content/page.sx")
+(load "lib/content/page-full.sx")
+(load "lib/content/markdown.sx")
+(load "lib/content/runs.sx")
+(load "lib/content/validate.sx")
+(load "lib/content/sanitize.sx")
+(load "lib/content/store.sx")
+(load "lib/content/snapshot.sx")
+(load "lib/content/crdt.sx")
+(load "lib/content/crdt-tree.sx")
+(load "lib/content/crdt-store.sx")
+(load "lib/content/sync.sx")
+(load "lib/content/md-import.sx")
+(load "lib/content/md-doc.sx")
+(load "lib/content/fed.sx")
+(epoch 2)
+(eval "(define content-test-pass 0)")
+(eval "(define content-test-fail 0)")
+(eval "(define content-test-fails (list))")
+(eval "(define content-test (fn (name got expected) (if (= got expected) (set! content-test-pass (+ content-test-pass 1)) (begin (set! content-test-fail (+ content-test-fail 1)) (set! content-test-fails (cons name content-test-fails))))))")
+(epoch 3)
+(load "${file}")
+(epoch 4)
+(eval "(list content-test-pass content-test-fail)")
+EPOCHS
+
+  local OUTPUT
+  OUTPUT=$(timeout 240 "$SX_SERVER" < "$TMP" 2>/dev/null)
+  rm -f "$TMP"
+
+  local LINE
+  LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
+  if [ -z "$LINE" ]; then
+    LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \
+            | sed -E 's/^\(ok 4 //; s/\)$//')
+  fi
+
+  local P F
+  P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
+  F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
+  P=${P:-0}
+  F=${F:-0}
+  echo "${P} ${F}"
+}
+
+declare -A SUITE_PASS
+declare -A SUITE_FAIL
+TOTAL_PASS=0
+TOTAL_FAIL=0
+
+echo "Running content conformance suite..." >&2
+for s in "${SUITES[@]}"; do
+  read -r p f < <(run_suite "$s")
+  SUITE_PASS[$s]=$p
+  SUITE_FAIL[$s]=$f
+  TOTAL_PASS=$((TOTAL_PASS + p))
+  TOTAL_FAIL=$((TOTAL_FAIL + f))
+  printf "  %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2
+done
+
+{
+  printf '{\n'
+  printf '  "suites": {\n'
+  first=1
+  for s in "${SUITES[@]}"; do
+    if [ $first -eq 0 ]; then printf ',\n'; fi
+    printf '    "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}"
+    first=0
+  done
+  printf '\n  },\n'
+  printf '  "total_pass": %d,\n' "$TOTAL_PASS"
+  printf '  "total_fail": %d,\n' "$TOTAL_FAIL"
+  printf '  "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))"
+  printf '}\n'
+} > "$OUT_JSON"
+
+{
+  printf '# content-on-sx Conformance Scoreboard\n\n'
+  printf '_Generated by `lib/content/conformance.sh`_\n\n'
+  printf '| Suite | Pass | Fail | Total |\n'
+  printf '|-------|-----:|-----:|------:|\n'
+  for s in "${SUITES[@]}"; do
+    p=${SUITE_PASS[$s]}
+    f=${SUITE_FAIL[$s]}
+    printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))"
+  done
+  printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))"
+} > "$OUT_MD"
+
+echo "Wrote $OUT_JSON and $OUT_MD" >&2
+echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2
+
+[ "$TOTAL_FAIL" -eq 0 ]

lib/content/crdt-store.sx

@@ -0,0 +1,71 @@
+;; content-on-sx — durable collaborative replication: CRDT ops on persist.
+;;
+;; Each replica appends its CRDT ops to its own persist stream
+;; (crdt:<doc>:<replica>). Any node reconstructs the converged document by
+;; replaying every replica's log into a CvRDT state and merging them. Because
+;; the merge is a join and crdt-apply is order/duplicate-insensitive, the
+;; converged result is identical regardless of replica order or re-delivery —
+;; the durable log + CRDT give offline-capable, eventually-consistent editing.
+;;
+;; Requires (loaded by harness): crdt.sx (+ deps) and persist
+;; (event/backend/log/kv/api). Backend `b` injected via (persist/open).
+
+(define crdt/-stream (fn (doc-id replica) (str "crdt:" doc-id ":" replica)))
+
+;; ── commit ops to a replica's durable log ──
+(define
+  crdt/commit!
+  (fn
+    (b doc-id replica op at)
+    (persist/append b (crdt/-stream doc-id replica) (get op :op) at op)))
+
+(define
+  crdt/commit-all!
+  (fn
+    (b doc-id replica ops at)
+    (if
+      (= (len ops) 0)
+      nil
+      (begin
+        (crdt/commit! b doc-id replica (first ops) at)
+        (crdt/commit-all! b doc-id replica (rest ops) at)))))
+
+;; ── read a replica's log ──
+(define
+  crdt/log
+  (fn (b doc-id replica) (persist/read b (crdt/-stream doc-id replica))))
+
+(define
+  crdt/replica-ops
+  (fn
+    (b doc-id replica)
+    (map (fn (ev) (persist/event-data ev)) (crdt/log b doc-id replica))))
+
+(define
+  crdt/replica-version
+  (fn (b doc-id replica) (persist/last-seq b (crdt/-stream doc-id replica))))
+
+;; ── replay one replica's log into a CvRDT state ──
+(define
+  crdt/replay
+  (fn
+    (b doc-id replica)
+    (crdt-apply-all (crdt-empty) (crdt/replica-ops b doc-id replica))))
+
+;; ── converge: merge every replica's replayed state ──
+(define
+  crdt/converge
+  (fn
+    (b doc-id replicas)
+    (crdt-merge-all (map (fn (r) (crdt/replay b doc-id r)) replicas))))
+
+;; ── converged, materialised document ──
+(define
+  crdt/document
+  (fn
+    (b doc-id replicas)
+    (crdt-materialize doc-id (crdt/converge b doc-id replicas))))
+
+(define
+  crdt/order
+  (fn (b doc-id replicas) (crdt-order (crdt/converge b doc-id replicas))))

lib/content/crdt-tree.sx

@@ -0,0 +1,193 @@
+;; content-on-sx — nested-tree CvRDT.
+;;
+;; Extends the flat CvRDT (crdt.sx) to a TREE: each element carries a `parent`
+;; (the id of its containing section, "" = root) alongside its Logoot position.
+;; Merge is still a join — it reuses crdt.sx's position/register/field merges and
+;; adds parent (immutable, set once at insert). Materialisation rebuilds the
+;; ordered tree: root = elements with parent "" (plus ORPHANS — elements whose
+;; parent is not a live section, e.g. after a concurrent delete-section +
+;; insert-child, so content is never silently lost); a section's children =
+;; elements whose parent is that section's id. Commutative/associative/idempotent
+;; like the flat layer.
+;;
+;; Requires (loaded by harness): crdt.sx (merge helpers + live/sort/materialise
+;; bits + crdt-member?), block.sx, doc.sx, section.sx (mk-section).
+
+(define ctt-merge-parent (fn (p1 p2) (if (= p1 nil) p2 p1)))
+
+(define ctt-merge-element (fn (e1 e2) {:fields (crdt-merge-fields (get e1 :fields) (get e2 :fields)) :parent (ctt-merge-parent (get e1 :parent) (get e2 :parent)) :id (get e1 :id) :type (crdt-merge-type (get e1 :type) (get e2 :type)) :deleted (or (= (get e1 :deleted) true) (= (get e2 :deleted) true)) :pos (crdt-merge-pos (get e1 :pos) (get e2 :pos))}))
+
+(define
+  ctt-add-element
+  (fn
+    (state elem)
+    (let
+      ((elems (get state :elements)) (id (get elem :id)))
+      (let
+        ((existing (get elems id)))
+        (assoc
+          state
+          :elements (assoc
+            elems
+            id
+            (if (= existing nil) elem (ctt-merge-element existing elem))))))))
+
+;; ── ops as partial-element contributions ──
+(define
+  crdt-tree-insert
+  (fn
+    (state id type pos parent fields ts actor)
+    (ctt-add-element state {:fields (crdt-build-fields fields ts actor) :parent parent :id id :type type :deleted false :pos pos})))
+
+(define
+  crdt-tree-update
+  (fn (state id fname value ts actor) (ctt-add-element state {:fields (assoc {} fname {:ts ts :actor actor :value value}) :parent nil :id id :type nil :deleted false :pos nil})))
+
+(define crdt-tree-delete (fn (state id) (ctt-add-element state {:fields {} :parent nil :id id :type nil :deleted true :pos nil})))
+
+;; ── state merge (join) ──
+(define
+  ctt-merge-loop
+  (fn
+    (ids ea eb acc)
+    (if
+      (= (len ids) 0)
+      acc
+      (let
+        ((id (first ids)))
+        (let
+          ((x (get ea id)) (y (get eb id)))
+          (ctt-merge-loop
+            (rest ids)
+            ea
+            eb
+            (assoc
+              acc
+              id
+              (cond
+                ((= x nil) y)
+                ((= y nil) x)
+                (else (ctt-merge-element x y))))))))))
+
+(define crdt-tree-merge (fn (a b) {:elements (ctt-merge-loop (crdt-union-keys (get a :elements) (get b :elements)) (get a :elements) (get b :elements) {})}))
+
+(define
+  crdt-tree-merge-all
+  (fn
+    (states)
+    (if
+      (= (len states) 0)
+      (crdt-empty)
+      (if
+        (= (len states) 1)
+        (first states)
+        (crdt-tree-merge (first states) (crdt-tree-merge-all (rest states)))))))
+
+;; ── op interpreter ──
+(define
+  crdt-tree-op-insert
+  (fn (id type pos parent fields ts actor) {:ts ts :fields fields :parent parent :id id :type type :op "insert" :actor actor :pos pos}))
+
+(define crdt-tree-op-update (fn (id field value ts actor) {:ts ts :field field :id id :op "update" :actor actor :value value}))
+
+(define crdt-tree-op-delete (fn (id) {:id id :op "delete"}))
+
+(define
+  crdt-tree-apply
+  (fn
+    (state op)
+    (let
+      ((k (get op :op)))
+      (cond
+        ((= k "insert")
+          (crdt-tree-insert
+            state
+            (get op :id)
+            (get op :type)
+            (get op :pos)
+            (get op :parent)
+            (get op :fields)
+            (get op :ts)
+            (get op :actor)))
+        ((= k "update")
+          (crdt-tree-update
+            state
+            (get op :id)
+            (get op :field)
+            (get op :value)
+            (get op :ts)
+            (get op :actor)))
+        ((= k "delete") (crdt-tree-delete state (get op :id)))
+        (else (error (str "unknown crdt-tree op: " k)))))))
+
+(define
+  crdt-tree-apply-all
+  (fn
+    (state ops)
+    (if
+      (= (len ops) 0)
+      state
+      (crdt-tree-apply-all (crdt-tree-apply state (first ops)) (rest ops)))))
+
+;; ── materialise to a Phase-1 document (rebuild the ordered tree) ──
+(define
+  ctt-live-section-ids
+  (fn
+    (state)
+    (map
+      (fn (e) (get e :id))
+      (filter
+        (fn (e) (= (get e :type) "section"))
+        (crdt-live-elements state)))))
+
+;; an element belongs at root if its parent is "" or its parent is not a live
+;; section (orphan-reparenting: don't lose content when its section is deleted).
+(define
+  ctt-roots
+  (fn
+    (state)
+    (let
+      ((secids (ctt-live-section-ids state)))
+      (crdt-sort-by-pos
+        (filter
+          (fn
+            (e)
+            (if
+              (= (get e :parent) "")
+              true
+              (if (crdt-member? (get e :parent) secids) false true)))
+          (crdt-live-elements state))))))
+
+(define
+  ctt-children
+  (fn
+    (state parent-id)
+    (crdt-sort-by-pos
+      (filter
+        (fn (e) (= (get e :parent) parent-id))
+        (crdt-live-elements state)))))
+
+(define
+  ctt-element->block
+  (fn
+    (state e)
+    (if
+      (= (get e :type) "section")
+      (mk-section
+        (get e :id)
+        (map
+          (fn (c) (ctt-element->block state c))
+          (ctt-children state (get e :id))))
+      (crdt-element->block e))))
+
+(define
+  crdt-tree-materialize
+  (fn
+    (doc-id state)
+    (doc-new
+      doc-id
+      (map (fn (e) (ctt-element->block state e)) (ctt-roots state)))))
+
+(define
+  crdt-tree-order
+  (fn (state) (map (fn (e) (get e :id)) (ctt-roots state))))

lib/content/crdt.sx

@@ -0,0 +1,378 @@
+;; content-on-sx — collaborative merge (state-based CvRDT).
+;;
+;; The merge is a join (least upper bound) on a semilattice, so it is
+;; commutative, associative and idempotent BY CONSTRUCTION — applying ops in any
+;; order, or merging replicas in any order / twice, converges to the same
+;; document. This is NOT last-write-wins-as-cop-out: ordering uses unique dense
+;; position keys (Logoot), presence uses OR-tombstones (remove-wins), and each
+;; field is an LWW-Register keyed by a logical (ts, actor) clock — an explicit,
+;; deterministic per-field conflict policy.
+;;
+;; Every op (insert/update/delete) contributes a PARTIAL element; the per-id
+;; state is the join of all contributions. So update-before-insert and
+;; delete-before-insert are not lost — they merge when the rest arrives.
+;;
+;; Shapes:
+;;   state    = {:elements <dict id -> element>}
+;;   element  = {:id :pos :type :deleted :fields <dict fname -> register>}
+;;   register = {:value v :ts <int> :actor <int>}
+;;   position = list of cells; cell = (list digit actor); lexicographic order
+;;
+;; Requires (loaded by harness): block.sx, doc.sx.
+
+(define CRDT-BASE 65536)
+
+;; ── position order (Logoot) ──
+(define
+  crdt-cell-cmp
+  (fn
+    (c1 c2)
+    (let
+      ((d1 (first c1)) (d2 (first c2)))
+      (cond
+        ((< d1 d2) -1)
+        ((> d1 d2) 1)
+        (else
+          (let
+            ((a1 (first (rest c1))) (a2 (first (rest c2))))
+            (cond
+              ((< a1 a2) -1)
+              ((> a1 a2) 1)
+              (else 0))))))))
+
+(define
+  crdt-pos-compare
+  (fn
+    (p1 p2)
+    (cond
+      ((and (= (len p1) 0) (= (len p2) 0)) 0)
+      ((= (len p1) 0) -1)
+      ((= (len p2) 0) 1)
+      (else
+        (let
+          ((c (crdt-cell-cmp (first p1) (first p2))))
+          (if (= c 0) (crdt-pos-compare (rest p1) (rest p2)) c))))))
+
+;; single-cell position constructor (handy for explicit tests)
+(define crdt-pos (fn (digit actor) (list (list digit actor))))
+
+;; allocate a position strictly between left and right (nil = unbounded)
+(define
+  cr-alloc
+  (fn
+    (left right actor i acc)
+    (let
+      ((ld (if (< i (len left)) (first (nth left i)) 0))
+        (rd (if (< i (len right)) (first (nth right i)) CRDT-BASE)))
+      (if
+        (> (- rd ld) 1)
+        (append
+          acc
+          (list
+            (list
+              (+
+                ld
+                (+
+                  1
+                  (floor (/ (- (- rd ld) 1) 2))))
+              actor)))
+        (cr-alloc
+          left
+          right
+          actor
+          (+ i 1)
+          (append
+            acc
+            (list
+              (list
+                ld
+                (if (< i (len left)) (first (rest (nth left i))) actor)))))))))
+
+(define
+  crdt-pos-between
+  (fn
+    (left right actor)
+    (cr-alloc
+      (if (= left nil) (list) left)
+      (if (= right nil) (list) right)
+      actor
+      0
+      (list))))
+
+;; ── register (LWW by logical (ts, actor)) ──
+(define
+  crdt-reg-max
+  (fn
+    (r1 r2)
+    (cond
+      ((= r1 nil) r2)
+      ((= r2 nil) r1)
+      (else
+        (let
+          ((t1 (get r1 :ts)) (t2 (get r2 :ts)))
+          (cond
+            ((> t1 t2) r1)
+            ((< t1 t2) r2)
+            (else (if (>= (get r1 :actor) (get r2 :actor)) r1 r2))))))))
+
+;; ── small set/dict helpers ──
+(define
+  crdt-member?
+  (fn
+    (x xs)
+    (cond
+      ((= (len xs) 0) false)
+      ((= (first xs) x) true)
+      (else (crdt-member? x (rest xs))))))
+
+(define
+  crdt-dedup-loop
+  (fn
+    (xs seen)
+    (if
+      (= (len xs) 0)
+      (reverse seen)
+      (if
+        (crdt-member? (first xs) seen)
+        (crdt-dedup-loop (rest xs) seen)
+        (crdt-dedup-loop (rest xs) (cons (first xs) seen))))))
+
+(define crdt-dedup (fn (xs) (crdt-dedup-loop xs (list))))
+
+(define
+  crdt-union-keys
+  (fn (d1 d2) (crdt-dedup (append (keys d1) (keys d2)))))
+
+;; ── element join ──
+(define
+  crdt-merge-pos
+  (fn
+    (p1 p2)
+    (cond
+      ((= p1 nil) p2)
+      ((= p2 nil) p1)
+      ((<= (crdt-pos-compare p1 p2) 0) p1)
+      (else p2))))
+
+(define crdt-merge-type (fn (t1 t2) (if (= t1 nil) t2 t1)))
+
+(define
+  crdt-merge-fields-loop
+  (fn
+    (names f1 f2 acc)
+    (if
+      (= (len names) 0)
+      acc
+      (let
+        ((nm (first names)))
+        (crdt-merge-fields-loop
+          (rest names)
+          f1
+          f2
+          (assoc acc nm (crdt-reg-max (get f1 nm) (get f2 nm))))))))
+
+(define
+  crdt-merge-fields
+  (fn
+    (f1 f2)
+    (crdt-merge-fields-loop (crdt-union-keys f1 f2) f1 f2 {})))
+
+(define crdt-merge-element (fn (e1 e2) {:fields (crdt-merge-fields (get e1 :fields) (get e2 :fields)) :id (get e1 :id) :type (crdt-merge-type (get e1 :type) (get e2 :type)) :deleted (or (= (get e1 :deleted) true) (= (get e2 :deleted) true)) :pos (crdt-merge-pos (get e1 :pos) (get e2 :pos))}))
+
+;; ── state ──
+(define crdt-empty (fn () {:elements {}}))
+
+(define
+  crdt-add-element
+  (fn
+    (state elem)
+    (let
+      ((elems (get state :elements)) (id (get elem :id)))
+      (let
+        ((existing (get elems id)))
+        (assoc
+          state
+          :elements (assoc
+            elems
+            id
+            (if (= existing nil) elem (crdt-merge-element existing elem))))))))
+
+(define
+  crdt-build-fields-loop
+  (fn
+    (pairs ts actor acc)
+    (if
+      (= (len pairs) 0)
+      acc
+      (crdt-build-fields-loop
+        (rest pairs)
+        ts
+        actor
+        (assoc acc (first (first pairs)) {:ts ts :actor actor :value (first (rest (first pairs)))})))))
+
+(define
+  crdt-build-fields
+  (fn (pairs ts actor) (crdt-build-fields-loop pairs ts actor {})))
+
+;; ── ops as partial-element contributions ──
+(define
+  crdt-insert
+  (fn
+    (state id type pos fields ts actor)
+    (crdt-add-element state {:fields (crdt-build-fields fields ts actor) :id id :type type :deleted false :pos pos})))
+
+(define
+  crdt-update
+  (fn (state id fname value ts actor) (crdt-add-element state {:fields (assoc {} fname {:ts ts :actor actor :value value}) :id id :type nil :deleted false :pos nil})))
+
+(define crdt-delete (fn (state id) (crdt-add-element state {:fields {} :id id :type nil :deleted true :pos nil})))
+
+;; ── state merge (join) ──
+(define
+  crdt-merge-loop
+  (fn
+    (ids ea eb acc)
+    (if
+      (= (len ids) 0)
+      acc
+      (let
+        ((id (first ids)))
+        (let
+          ((x (get ea id)) (y (get eb id)))
+          (crdt-merge-loop
+            (rest ids)
+            ea
+            eb
+            (assoc
+              acc
+              id
+              (cond
+                ((= x nil) y)
+                ((= y nil) x)
+                (else (crdt-merge-element x y))))))))))
+
+(define crdt-merge (fn (a b) {:elements (crdt-merge-loop (crdt-union-keys (get a :elements) (get b :elements)) (get a :elements) (get b :elements) {})}))
+
+(define
+  crdt-merge-all
+  (fn
+    (states)
+    (if
+      (= (len states) 0)
+      (crdt-empty)
+      (if
+        (= (len states) 1)
+        (first states)
+        (crdt-merge (first states) (crdt-merge-all (rest states)))))))
+
+;; ── op interpreter ──
+(define crdt-op-insert (fn (id type pos fields ts actor) {:ts ts :fields fields :id id :type type :op "insert" :actor actor :pos pos}))
+
+(define crdt-op-update (fn (id field value ts actor) {:ts ts :field field :id id :op "update" :actor actor :value value}))
+
+(define crdt-op-delete (fn (id) {:id id :op "delete"}))
+
+(define
+  crdt-apply
+  (fn
+    (state op)
+    (let
+      ((k (get op :op)))
+      (cond
+        ((= k "insert")
+          (crdt-insert
+            state
+            (get op :id)
+            (get op :type)
+            (get op :pos)
+            (get op :fields)
+            (get op :ts)
+            (get op :actor)))
+        ((= k "update")
+          (crdt-update
+            state
+            (get op :id)
+            (get op :field)
+            (get op :value)
+            (get op :ts)
+            (get op :actor)))
+        ((= k "delete") (crdt-delete state (get op :id)))
+        (else (error (str "unknown crdt op: " k)))))))
+
+(define
+  crdt-apply-all
+  (fn
+    (state ops)
+    (if
+      (= (len ops) 0)
+      state
+      (crdt-apply-all (crdt-apply state (first ops)) (rest ops)))))
+
+;; ── materialise to a Phase-1 document ──
+(define
+  crdt-elements-list
+  (fn
+    (state)
+    (map
+      (fn (id) (get (get state :elements) id))
+      (keys (get state :elements)))))
+
+(define
+  crdt-live?
+  (fn
+    (e)
+    (and
+      (= (get e :deleted) false)
+      (if (= (get e :pos) nil) false true)
+      (if (= (get e :type) nil) false true))))
+
+(define
+  crdt-live-elements
+  (fn (state) (filter crdt-live? (crdt-elements-list state))))
+
+(define
+  crdt-insert-sorted
+  (fn
+    (e sorted)
+    (cond
+      ((= (len sorted) 0) (list e))
+      ((< (crdt-pos-compare (get e :pos) (get (first sorted) :pos)) 0)
+        (cons e sorted))
+      (else (cons (first sorted) (crdt-insert-sorted e (rest sorted)))))))
+
+(define
+  crdt-sort-by-pos
+  (fn
+    (elems)
+    (if
+      (= (len elems) 0)
+      (list)
+      (crdt-insert-sorted (first elems) (crdt-sort-by-pos (rest elems))))))
+
+(define
+  crdt-field-pairs
+  (fn
+    (fields)
+    (map (fn (nm) (list nm (get (get fields nm) :value))) (keys fields))))
+
+(define
+  crdt-element->block
+  (fn
+    (e)
+    (mk-block (get e :type) (get e :id) (crdt-field-pairs (get e :fields)))))
+
+(define
+  crdt-order
+  (fn
+    (state)
+    (map
+      (fn (e) (get e :id))
+      (crdt-sort-by-pos (crdt-live-elements state)))))
+
+(define
+  crdt-materialize
+  (fn
+    (doc-id state)
+    (doc-new
+      doc-id
+      (map crdt-element->block (crdt-sort-by-pos (crdt-live-elements state))))))

lib/content/data.sx

@@ -0,0 +1,79 @@
+;; content-on-sx — portable data serialization.
+;;
+;; Converts documents to/from a plain SX data form, decoupling storage and
+;; transport from the Smalltalk instance shape. A document becomes
+;;   {:id :title :slug :tags :blocks (list block-data)}
+;; and a block becomes {:id :type :fields {...}} (section children recurse).
+;; content/from-data reconstructs real block objects.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx, meta.sx, section.sx
+;; (mk-section), table.sx (mk-table).
+
+;; ── to-data ──
+(define
+  content/-fd-loop
+  (fn
+    (ks ivs acc)
+    (if
+      (= (len ks) 0)
+      acc
+      (let
+        ((k (first ks)))
+        (if
+          (= k "id")
+          (content/-fd-loop (rest ks) ivs acc)
+          (content/-fd-loop
+            (rest ks)
+            ivs
+            (assoc
+              acc
+              k
+              (if
+                (= k "children")
+                (map block->data (get ivs k))
+                (get ivs k)))))))))
+
+(define block->data (fn (b) {:fields (content/-fd-loop (keys (get b :ivars)) (get b :ivars) {}) :id (blk-id b) :type (blk-type b)}))
+
+(define content/to-data (fn (doc) {:blocks (map block->data (doc-blocks doc)) :slug (doc-slug doc) :id (doc-id doc) :title (doc-title doc) :tags (doc-tags doc)}))
+
+;; ── from-data ──
+(define
+  content/-field-pairs
+  (fn (fields) (map (fn (k) (list k (get fields k))) (keys fields))))
+
+(define
+  data->block
+  (fn
+    (d)
+    (let
+      ((type (get d :type)) (id (get d :id)) (fields (get d :fields)))
+      (cond
+        ((= type "section")
+          (mk-section id (map data->block (get fields "children"))))
+        ((= type "table")
+          (mk-table id (get fields "headers") (get fields "rows")))
+        (else (mk-block type id (content/-field-pairs fields)))))))
+
+(define
+  content/-meta-of
+  (fn
+    (data)
+    (let
+      ((m1 (if (= (get data :title) nil) {} (assoc {} :title (get data :title)))))
+      (let
+        ((m2 (if (= (get data :slug) nil) m1 (assoc m1 :slug (get data :slug)))))
+        (let
+          ((tags (get data :tags)))
+          (if
+            (or (= tags nil) (= (len tags) 0))
+            m2
+            (assoc m2 :tags tags)))))))
+
+(define
+  content/from-data
+  (fn
+    (data)
+    (doc-with-meta
+      (doc-new (get data :id) (map data->block (get data :blocks)))
+      (content/-meta-of data))))

lib/content/doc.sx

@@ -0,0 +1,257 @@
+;; content-on-sx — ordered block document on Smalltalk-on-SX.
+;;
+;; A document (CtDoc) is a Smalltalk object holding an ordered sequence of block
+;; objects. Editing is a stream of ops (data dicts); doc-apply interprets one op
+;; and returns a NEW document — the input is never mutated, so any version is the
+;; head of an op stream (replay-friendly for persist + CRDT merge).
+;;
+;; By-id ops (update/delete) and by-id lookup (doc-find-deep/doc-has-deep?) are
+;; TREE-WIDE: they descend into any block carrying a `children` list (i.e.
+;; sections), since ids are unique across the tree. This keeps the persist
+;; op-log, content/edit and content/find correct for nested documents.
+;; insert/move are positional and act at the top level.
+;;
+;; CtDoc also carries optional metadata (title/slug/tags) — see meta.sx.
+;;
+;; Op shapes (data, not objects — they are the persist event payload):
+;;   {:op "insert" :block <blk> :after <id|nil>}   ; after nil = prepend (top level)
+;;   {:op "update" :id <id> :field <name> :value <v>}   ; tree-wide by id
+;;   {:op "move"   :id <id> :index <n>}                 ; top level
+;;   {:op "delete" :id <id>}                            ; tree-wide by id
+
+(define
+  content-bootstrap-doc!
+  (fn
+    ()
+    (begin
+      (st-class-define!
+        "CtDoc"
+        "Object"
+        (list "id" "blocks" "title" "slug" "tags"))
+      (ct-def-method! "CtDoc" "id" "id ^ id")
+      (ct-def-method! "CtDoc" "blocks" "blocks ^ blocks")
+      (ct-def-method! "CtDoc" "type" "type ^ #document")
+      (ct-def-method! "CtDoc" "title" "title ^ title")
+      (ct-def-method! "CtDoc" "slug" "slug ^ slug")
+      (ct-def-method! "CtDoc" "tags" "tags ^ tags")
+      true)))
+
+;; ── construction ──
+(define
+  doc-new
+  (fn
+    (id blocks)
+    (st-iv-set!
+      (st-iv-set! (st-make-instance "CtDoc") "id" id)
+      "blocks"
+      blocks)))
+
+(define doc-empty (fn (id) (doc-new id (list))))
+
+;; ── accessors (message dispatch) ──
+(define doc-id (fn (doc) (st-send doc "id" (list))))
+(define doc-type (fn (doc) (str (st-send doc "type" (list)))))
+(define doc-blocks (fn (doc) (st-send doc "blocks" (list))))
+(define doc-count (fn (doc) (len (doc-blocks doc))))
+(define doc-block-at (fn (doc i) (nth (doc-blocks doc) i)))
+
+(define doc? (fn (v) (and (st-instance? v) (= (get v :class) "CtDoc"))))
+
+;; ── list helpers over block sequences ──
+(define
+  ct-index-loop
+  (fn
+    (blocks id i)
+    (cond
+      ((= (len blocks) 0) -1)
+      ((= (blk-id (first blocks)) id) i)
+      (else (ct-index-loop (rest blocks) id (+ i 1))))))
+
+(define ct-index-of (fn (blocks id) (ct-index-loop blocks id 0)))
+
+(define
+  ct-insert-at
+  (fn
+    (blocks i x)
+    (cond
+      ((= i 0) (cons x blocks))
+      ((= (len blocks) 0) (list x))
+      (else
+        (cons
+          (first blocks)
+          (ct-insert-at (rest blocks) (- i 1) x))))))
+
+;; tree-wide remove by id: drop matches at this level, recurse into children
+;; (blocks carrying a `children` list, i.e. sections).
+(define
+  ct-remove-id
+  (fn
+    (blocks id)
+    (map
+      (fn
+        (b)
+        (let
+          ((ch (st-iv-get b "children")))
+          (if (list? ch) (st-iv-set! b "children" (ct-remove-id ch id)) b)))
+      (filter (fn (b) (if (= (blk-id b) id) false true)) blocks))))
+
+;; tree-wide replace by id: apply f to the match wherever it sits in the tree.
+(define
+  ct-replace-id
+  (fn
+    (blocks id f)
+    (map
+      (fn
+        (b)
+        (if
+          (= (blk-id b) id)
+          (f b)
+          (let
+            ((ch (st-iv-get b "children")))
+            (if
+              (list? ch)
+              (st-iv-set! b "children" (ct-replace-id ch id f))
+              b))))
+      blocks)))
+
+;; tree-wide find by id: first block matching id anywhere in the tree, or nil.
+;; Descends into any `children` list, mirroring ct-replace-id/ct-remove-id.
+(define
+  ct-find-id
+  (fn
+    (blocks id)
+    (if
+      (= (len blocks) 0)
+      nil
+      (let
+        ((b (first blocks)))
+        (if
+          (= (blk-id b) id)
+          b
+          (let
+            ((ch (st-iv-get b "children")))
+            (let
+              ((nested (if (list? ch) (ct-find-id ch id) nil)))
+              (if (= nested nil) (ct-find-id (rest blocks) id) nested))))))))
+
+;; ── query ──
+(define doc-index-of (fn (doc id) (ct-index-of (doc-blocks doc) id)))
+
+(define
+  doc-find
+  (fn
+    (doc id)
+    (let
+      ((hits (filter (fn (b) (= (blk-id b) id)) (doc-blocks doc))))
+      (if (= (len hits) 0) nil (first hits)))))
+
+(define
+  doc-has?
+  (fn (doc id) (if (= (doc-index-of doc id) -1) false true)))
+
+;; tree-wide lookup by id — reads a nested block by the same id content/edit can
+;; update/delete (no section.sx dependency; uses the generic children descent).
+(define doc-find-deep (fn (doc id) (ct-find-id (doc-blocks doc) id)))
+
+(define
+  doc-has-deep?
+  (fn (doc id) (if (= (doc-find-deep doc id) nil) false true)))
+
+;; ── structural edits (each returns a new document) ──
+(define doc-with-blocks (fn (doc blocks) (st-iv-set! doc "blocks" blocks)))
+
+(define
+  doc-append
+  (fn
+    (doc block)
+    (doc-with-blocks doc (append (doc-blocks doc) (list block)))))
+
+(define
+  doc-insert-at
+  (fn
+    (doc block i)
+    (doc-with-blocks doc (ct-insert-at (doc-blocks doc) i block))))
+
+(define
+  doc-insert-after
+  (fn
+    (doc block after-id)
+    (let
+      ((blocks (doc-blocks doc)))
+      (if
+        (= after-id nil)
+        (doc-with-blocks doc (cons block blocks))
+        (let
+          ((idx (ct-index-of blocks after-id)))
+          (if
+            (= idx -1)
+            (doc-with-blocks doc (append blocks (list block)))
+            (doc-with-blocks
+              doc
+              (ct-insert-at blocks (+ idx 1) block))))))))
+
+(define
+  doc-update
+  (fn
+    (doc id field value)
+    (doc-with-blocks
+      doc
+      (ct-replace-id (doc-blocks doc) id (fn (b) (blk-set b field value))))))
+
+(define
+  doc-delete
+  (fn (doc id) (doc-with-blocks doc (ct-remove-id (doc-blocks doc) id))))
+
+(define
+  doc-move
+  (fn
+    (doc id i)
+    (let
+      ((blk (doc-find doc id)))
+      (if
+        (= blk nil)
+        doc
+        (doc-with-blocks
+          doc
+          (ct-insert-at (ct-remove-id (doc-blocks doc) id) i blk))))))
+
+;; ── op constructors (data payload, reused by persist op log) ──
+(define op-insert (fn (block after) {:after after :op "insert" :block block}))
+
+(define op-update (fn (id field value) {:field field :id id :op "update" :value value}))
+
+(define op-move (fn (id index) {:id id :op "move" :index index}))
+
+(define op-delete (fn (id) {:id id :op "delete"}))
+
+;; ── op interpreter ──
+(define
+  doc-apply
+  (fn
+    (doc op)
+    (let
+      ((kind (get op :op)))
+      (cond
+        ((= kind "insert")
+          (doc-insert-after doc (get op :block) (get op :after)))
+        ((= kind "update")
+          (doc-update doc (get op :id) (get op :field) (get op :value)))
+        ((= kind "move") (doc-move doc (get op :id) (get op :index)))
+        ((= kind "delete") (doc-delete doc (get op :id)))
+        (else (error (str "unknown op: " kind)))))))
+
+(define
+  doc-apply-all
+  (fn
+    (doc ops)
+    (if
+      (= (len ops) 0)
+      doc
+      (doc-apply-all (doc-apply doc (first ops)) (rest ops)))))
+
+;; ── render-agnostic snapshot: list of (id . type) for assertions/debug ──
+(define doc-ids (fn (doc) (map (fn (b) (blk-id b)) (doc-blocks doc))))
+
+(define
+  doc-types
+  (fn (doc) (map (fn (b) (blk-type b)) (doc-blocks doc))))

lib/content/fed.sx

@@ -0,0 +1,68 @@
+;; content-on-sx — federated documents: trust-gated peer-authored ops.
+;;
+;; A peer-authored op carries provenance (:author, and a :sig stub). We never
+;; auto-accept: a peer op is applied only if it passes a trust gate. The gate is
+;; a predicate (fn op -> bool) so acl-on-sx can inject real trust facts later;
+;; the convenience form takes an explicit trusted-actor list (the stub).
+;;
+;; Accepted ops flow through the CvRDT merge (Phase 3), so concurrent local and
+;; external edits reconcile deterministically (same-field LWW, order-independent).
+;;
+;; Requires (loaded by harness): crdt.sx (and its deps).
+
+;; tag an op with provenance
+(define content/authored (fn (op author) (assoc op :author author)))
+
+(define
+  content/signed
+  (fn (op author sig) (assoc (assoc op :author author) :sig sig)))
+
+;; explicit trust stub: membership in a trusted-actor list
+(define content/trusted? (fn (trust author) (crdt-member? author trust)))
+
+;; general form: accept? is a predicate (fn op -> bool). Applies accepted ops
+;; through the CRDT; quarantines the rest. Returns
+;; {:state :accepted (ops) :rejected (ops)}.
+(define
+  content/-merge-peer-loop
+  (fn
+    (state accept? ops accepted rejected)
+    (if
+      (= (len ops) 0)
+      {:state state :accepted (reverse accepted) :rejected (reverse rejected)}
+      (let
+        ((op (first ops)))
+        (if
+          (accept? op)
+          (content/-merge-peer-loop
+            (crdt-apply state op)
+            accept?
+            (rest ops)
+            (cons op accepted)
+            rejected)
+          (content/-merge-peer-loop
+            state
+            accept?
+            (rest ops)
+            accepted
+            (cons op rejected)))))))
+
+(define
+  content/merge-peer-with
+  (fn
+    (state accept? ops)
+    (content/-merge-peer-loop state accept? ops (list) (list))))
+
+;; convenience: trust = list of trusted actor ids
+(define
+  content/merge-peer
+  (fn
+    (state trust ops)
+    (content/merge-peer-with
+      state
+      (fn (op) (content/trusted? trust (get op :author)))
+      ops)))
+
+(define content/accepted (fn (res) (get res :accepted)))
+(define content/rejected (fn (res) (get res :rejected)))
+(define content/peer-state (fn (res) (get res :state)))

lib/content/find-replace.sx

@@ -0,0 +1,97 @@
+;; content-on-sx — global find/replace across every text-bearing field.
+;;
+;; Replaces every occurrence of `from` with `to` in the text-bearing fields of
+;; a document, tree-wide (via the transform layer):
+;;   - the `text` of text / heading / code / quote / callout blocks
+;;   - the `alt` of image blocks
+;;   - each item of list blocks
+;;   - every header and cell of table blocks
+;; This is exactly the set asText / stats / summary draw prose from, so a rename
+;; via content/find-replace and a word count over asText stay consistent.
+;; Immutable; case-sensitive.
+;;
+;; A text field may be a plain string OR a list of rich-text runs (Phase 5,
+;; run = (text marks href)). fr-rep-text rewrites per run, preserving each run's
+;; marks/href; a match that physically straddles two runs is not joined (the
+;; replacement would have no single mark set) — each run is rewritten in place.
+;;
+;; Requires (loaded by harness): block.sx, transform.sx (content/map-blocks),
+;; table.sx (CtTable ivars).
+
+(define
+  fr-in?
+  (fn
+    (x xs)
+    (cond
+      ((= (len xs) 0) false)
+      ((= (first xs) x) true)
+      (else (fr-in? x (rest xs))))))
+
+(define fr-rep (fn (s from to) (replace (str s) from to)))
+
+;; rewrite a text-bearing field that is either a plain string or a runs list
+(define
+  fr-rep-text
+  (fn
+    (v from to)
+    (if
+      (list? v)
+      (map
+        (fn
+          (r)
+          (list
+            (fr-rep (nth r 0) from to)
+            (nth r 1)
+            (nth r 2)))
+        v)
+      (fr-rep v from to))))
+
+;; Blocks whose prose content find/replace rewrites (matches asText's set).
+(define
+  fr-has-text?
+  (fn
+    (b)
+    (fr-in?
+      (blk-type b)
+      (list "text" "heading" "code" "quote" "callout" "image" "list" "table"))))
+
+;; Per-type field rewrite. Each branch returns a new (copy-on-write) block.
+(define
+  fr-rewrite
+  (fn
+    (b from to)
+    (let
+      ((t (blk-type b)))
+      (cond
+        ((= t "image")
+          (blk-set b "alt" (fr-rep (blk-get b "alt") from to)))
+        ((= t "list")
+          (let
+            ((items (blk-get b "items")))
+            (if
+              (list? items)
+              (blk-set b "items" (map (fn (it) (fr-rep it from to)) items))
+              b)))
+        ((= t "table")
+          (let
+            ((hs (blk-get b "headers")) (rs (blk-get b "rows")))
+            (let
+              ((b1 (if (list? hs) (blk-set b "headers" (map (fn (h) (fr-rep h from to)) hs)) b)))
+              (if
+                (list? rs)
+                (blk-set
+                  b1
+                  "rows"
+                  (map
+                    (fn
+                      (r)
+                      (if (list? r) (map (fn (c) (fr-rep c from to)) r) r))
+                    rs))
+                b1))))
+        (else (blk-set b "text" (fr-rep-text (blk-get b "text") from to)))))))
+
+(define
+  content/find-replace
+  (fn
+    (doc from to)
+    (content/map-blocks doc fr-has-text? (fn (b) (fr-rewrite b from to)))))

lib/content/flatten.sx

@@ -0,0 +1,34 @@
+;; content-on-sx — document flatten.
+;;
+;; Un-nests a sectioned document into a flat block sequence: each section is
+;; replaced inline by its (recursively flattened) children, dropping the section
+;; wrapper. The inverse of content/wrap-section, for flat export targets.
+;; Immutable; inline tree handling (no section.sx dep).
+;;
+;; Requires (loaded by harness): block.sx, doc.sx.
+
+(define
+  flat-section?
+  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
+
+(define
+  flat-blocks
+  (fn
+    (blocks)
+    (if
+      (= (len blocks) 0)
+      (list)
+      (let
+        ((b (first blocks)))
+        (append
+          (if
+            (flat-section? b)
+            (let
+              ((ch (st-iv-get b "children")))
+              (if (list? ch) (flat-blocks ch) (list)))
+            (list b))
+          (flat-blocks (rest blocks)))))))
+
+(define
+  content/flatten
+  (fn (doc) (doc-with-blocks doc (flat-blocks (doc-blocks doc)))))

lib/content/index.sx

@@ -0,0 +1,51 @@
+;; content-on-sx — multi-document index.
+;;
+;; Projects a list of documents into summary cards (the blog index page), with
+;; tag filtering (category pages) and a tag cloud. Composes content/summary +
+;; doc metadata.
+;;
+;; Requires (loaded by harness): summary.sx (content/summary), meta.sx (doc-tags).
+
+(define
+  idx-in?
+  (fn
+    (x xs)
+    (cond
+      ((= (len xs) 0) false)
+      ((= (first xs) x) true)
+      (else (idx-in? x (rest xs))))))
+
+(define
+  idx-dedup
+  (fn
+    (xs seen)
+    (if
+      (= (len xs) 0)
+      (reverse seen)
+      (if
+        (idx-in? (first xs) seen)
+        (idx-dedup (rest xs) seen)
+        (idx-dedup (rest xs) (cons (first xs) seen))))))
+
+(define content/index (fn (docs) (map content/summary docs)))
+
+(define content/has-tag? (fn (doc tag) (idx-in? tag (doc-tags doc))))
+
+(define
+  content/index-by-tag
+  (fn
+    (docs tag)
+    (map content/summary (filter (fn (d) (content/has-tag? d tag)) docs))))
+
+(define
+  content/all-tags
+  (fn (docs) (idx-dedup (ct-flatmap-tags docs) (list))))
+
+(define
+  ct-flatmap-tags
+  (fn
+    (docs)
+    (if
+      (= (len docs) 0)
+      (list)
+      (append (doc-tags (first docs)) (ct-flatmap-tags (rest docs))))))

lib/content/markdown.sx

@@ -0,0 +1,55 @@
+;; content-on-sx — Markdown render mode.
+;;
+;; A third boundary format alongside asHTML / asSx, via the same polymorphic
+;; dispatch. The newline is supplied by the boundary as a keyword arg
+;; (asMarkdown: nl) because this Smalltalk dialect has no Character newline
+;; constructor — blocks that need internal newlines (code, lists, doc) use it.
+;;
+;; No Markdown escaping yet (Markdown's escaping rules differ from HTML); raw
+;; text is emitted. Ordered lists emit "1." for every item (Markdown renumbers).
+;;
+;; Requires (loaded by harness): block.sx, doc.sx.
+
+(define
+  content-bootstrap-markdown!
+  (fn
+    ()
+    (begin
+      (ct-def-method!
+        "CtHeading"
+        "asMarkdown:"
+        "asMarkdown: nl | h i | h := ''. i := 0. [i < level] whileTrue: [h := h , '#'. i := i + 1]. ^ h , ' ' , text")
+      (ct-def-method! "CtText" "asMarkdown:" "asMarkdown: nl ^ text")
+      (ct-def-method!
+        "CtCode"
+        "asMarkdown:"
+        "asMarkdown: nl ^ '```' , language , nl , text , nl , '```'")
+      (ct-def-method! "CtQuote" "asMarkdown:" "asMarkdown: nl ^ '> ' , text")
+      (ct-def-method!
+        "CtImage"
+        "asMarkdown:"
+        "asMarkdown: nl ^ '![' , alt , '](' , src , ')'")
+      (ct-def-method!
+        "CtEmbed"
+        "asMarkdown:"
+        "asMarkdown: nl ^ '[embed](' , url , ')'")
+      (ct-def-method! "CtDivider" "asMarkdown:" "asMarkdown: nl ^ '---'")
+      (ct-def-method!
+        "CtList"
+        "asMarkdown:"
+        "asMarkdown: nl | mark | mark := ordered ifTrue: ['1. '] ifFalse: ['- ']. ^ (items inject: '' into: [:a :x | a , (a = '' ifTrue: [''] ifFalse: [nl]) , mark , x])")
+      (ct-def-method!
+        "CtDoc"
+        "asMarkdown:"
+        "asMarkdown: nl ^ (blocks inject: '' into: [:a :b | a , (a = '' ifTrue: [''] ifFalse: [nl , nl]) , (b asMarkdown: nl)])")
+      true)))
+
+(define ct-nl (str "\n"))
+
+;; ── SX boundary ──
+(define
+  asMarkdown
+  (fn (node) (str (st-send node "asMarkdown:" (list ct-nl)))))
+(define content/markdown asMarkdown)
+(define render-markdown asMarkdown)
+(define block-markdown asMarkdown)

lib/content/md-doc.sx

@@ -0,0 +1,63 @@
+;; content-on-sx — Markdown document export (frontmatter + body).
+;;
+;; content/markdown-doc emits a YAML-ish --- frontmatter block from the document
+;; metadata (title/slug/tags) followed by the Markdown body, completing the
+;; metadata round-trip with md/import (md/import ∘ content/markdown-doc keeps
+;; title/slug/tags). With no metadata it is just asMarkdown.
+;;
+;; Requires (loaded by harness): doc.sx, meta.sx (doc-title/slug/tags),
+;; markdown.sx (asMarkdown).
+
+(define mdd-nl (str "\n"))
+
+(define
+  mdd-join
+  (fn
+    (sep parts)
+    (cond
+      ((= (len parts) 0) "")
+      ((= (len parts) 1) (first parts))
+      (else (str (first parts) sep (mdd-join sep (rest parts)))))))
+
+(define
+  content/-fm-parts
+  (fn
+    (doc)
+    (append
+      (append
+        (if
+          (= (doc-title doc) nil)
+          (list)
+          (list (str "title: " (doc-title doc))))
+        (if
+          (= (doc-slug doc) nil)
+          (list)
+          (list (str "slug: " (doc-slug doc)))))
+      (let
+        ((tags (doc-tags doc)))
+        (if
+          (= (len tags) 0)
+          (list)
+          (list (str "tags: " (mdd-join ", " tags))))))))
+
+(define
+  content/-frontmatter
+  (fn
+    (doc)
+    (let
+      ((parts (content/-fm-parts doc)))
+      (if
+        (= (len parts) 0)
+        ""
+        (str "---" mdd-nl (mdd-join mdd-nl parts) mdd-nl "---")))))
+
+(define
+  content/markdown-doc
+  (fn
+    (doc)
+    (let
+      ((fm (content/-frontmatter doc)))
+      (if
+        (= fm "")
+        (asMarkdown doc)
+        (str fm mdd-nl mdd-nl (asMarkdown doc))))))

lib/content/md-import.sx

@@ -0,0 +1,449 @@
+;; content-on-sx — Markdown import adapter (markdown text -> block document).
+;;
+;; A line-based parser, the inverse of markdown.sx's asMarkdown. Confined to the
+;; adapter boundary: the core knows nothing about Markdown. Handles a leading
+;; --- frontmatter block (key: value -> doc metadata), ATX headings (#..######),
+;; fenced code (```lang), blockquotes (> ), unordered (- / * ) and ordered (1. )
+;; lists, thematic breaks (--- / ***), pipe tables (header + --- separator +
+;; body), and paragraphs (consecutive plain lines joined with a space). Block ids
+;; are assigned sequentially b0,b1…
+;;
+;; Requires (loaded by harness): block.sx, doc.sx, table.sx (mk-table),
+;; meta.sx (doc-with-meta); markdown.sx for the adapter's export side.
+
+(define md/-id (fn (i) (str "b" i)))
+(define md/-blank? (fn (s) (= s "")))
+(define md/-hr? (fn (s) (if (= s "---") true (= s "***"))))
+
+(define
+  ct-in?
+  (fn
+    (x xs)
+    (cond
+      ((= (len xs) 0) false)
+      ((= (first xs) x) true)
+      (else (ct-in? x (rest xs))))))
+
+(define
+  ct-starts-with?
+  (fn
+    (s prefix)
+    (and
+      (>= (string-length s) (string-length prefix))
+      (= (substring s 0 (string-length prefix)) prefix))))
+
+(define
+  md/-drop
+  (fn (s prefix) (substring s (string-length prefix) (string-length s))))
+
+(define
+  md/-drop-n
+  (fn
+    (xs n)
+    (if
+      (= n 0)
+      xs
+      (if
+        (= (len xs) 0)
+        xs
+        (md/-drop-n (rest xs) (- n 1))))))
+
+(define
+  md/-join-with
+  (fn
+    (sep parts)
+    (cond
+      ((= (len parts) 0) "")
+      ((= (len parts) 1) (first parts))
+      (else (str (first parts) sep (md/-join-with sep (rest parts)))))))
+(define md/-join-sp (fn (parts) (md/-join-with " " parts)))
+(define md/-join-nl (fn (parts) (md/-join-with (str "\n") parts)))
+
+;; ── heading detection (leading #s then a space) ──
+(define
+  md/-hashes
+  (fn
+    (s n)
+    (if
+      (and
+        (< n (string-length s))
+        (= (substring s n (+ n 1)) "#"))
+      (md/-hashes s (+ n 1))
+      n)))
+(define
+  md/-heading?
+  (fn
+    (line)
+    (let
+      ((n (md/-hashes line 0)))
+      (and
+        (> n 0)
+        (<= n 6)
+        (> (string-length line) n)
+        (= (substring line n (+ n 1)) " ")))))
+(define
+  md/-heading-block
+  (fn
+    (line i)
+    (let
+      ((n (md/-hashes line 0)))
+      (mk-heading
+        (md/-id i)
+        n
+        (substring line (+ n 1) (string-length line))))))
+
+;; ── list detection ──
+(define
+  ct-digit?
+  (fn (ch) (ct-in? ch (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))))
+(define
+  md/-digits
+  (fn
+    (s n)
+    (if
+      (and
+        (< n (string-length s))
+        (ct-digit? (substring s n (+ n 1))))
+      (md/-digits s (+ n 1))
+      n)))
+(define
+  md/-ol?
+  (fn
+    (line)
+    (let
+      ((n (md/-digits line 0)))
+      (and
+        (> n 0)
+        (>= (string-length line) (+ n 2))
+        (= (substring line n (+ n 2)) ". ")))))
+(define
+  md/-drop-ol
+  (fn
+    (line)
+    (let
+      ((n (md/-digits line 0)))
+      (substring line (+ n 2) (string-length line)))))
+(define
+  md/-ul?
+  (fn
+    (line)
+    (if (ct-starts-with? line "- ") true (ct-starts-with? line "* "))))
+(define
+  md/-drop-ul
+  (fn (line) (substring line 2 (string-length line))))
+
+;; ── table detection ──
+(define md/-pipe-row? (fn (line) (ct-starts-with? (trim line) "|")))
+(define md/-sep-char? (fn (ch) (ct-in? ch (list "-" ":" "|" " "))))
+(define
+  md/-all-sep?
+  (fn
+    (s i)
+    (if
+      (>= i (string-length s))
+      true
+      (if
+        (md/-sep-char? (substring s i (+ i 1)))
+        (md/-all-sep? s (+ i 1))
+        false))))
+(define
+  md/-has-dash?
+  (fn
+    (s i)
+    (if
+      (>= i (string-length s))
+      false
+      (if
+        (= (substring s i (+ i 1)) "-")
+        true
+        (md/-has-dash? s (+ i 1))))))
+(define
+  md/-sep-row?
+  (fn
+    (line)
+    (and
+      (md/-pipe-row? line)
+      (md/-all-sep? (trim line) 0)
+      (md/-has-dash? line 0))))
+(define
+  md/-table-start?
+  (fn
+    (lines)
+    (and
+      (md/-pipe-row? (first lines))
+      (> (len lines) 1)
+      (md/-sep-row? (nth lines 1)))))
+(define
+  md/-strip-pipes
+  (fn
+    (s0)
+    (let
+      ((s (trim s0)))
+      (let
+        ((a (if (ct-starts-with? s "|") (substring s 1 (string-length s)) s)))
+        (if
+          (and
+            (> (string-length a) 0)
+            (=
+              (substring
+                a
+                (- (string-length a) 1)
+                (string-length a))
+              "|"))
+          (substring a 0 (- (string-length a) 1))
+          a)))))
+(define
+  md/-cells
+  (fn (line) (map (fn (c) (trim c)) (split (md/-strip-pipes line) "|"))))
+
+(define
+  md/-plain?
+  (fn
+    (line)
+    (if
+      (md/-blank? line)
+      false
+      (if
+        (ct-starts-with? line "```")
+        false
+        (if
+          (md/-heading? line)
+          false
+          (if
+            (ct-starts-with? line "> ")
+            false
+            (if
+              (md/-hr? line)
+              false
+              (if (md/-ul? line) false (if (md/-ol? line) false true)))))))))
+
+;; ── multi-line collectors ──
+(define
+  md/-code
+  (fn
+    (lines i acc)
+    (md/-code-collect
+      (rest lines)
+      (md/-drop (first lines) "```")
+      (list)
+      i
+      acc)))
+(define
+  md/-code-collect
+  (fn
+    (lines lang body i acc)
+    (cond
+      ((= (len lines) 0)
+        (md/-walk
+          lines
+          (+ i 1)
+          (cons (mk-code (md/-id i) lang (md/-join-nl (reverse body))) acc)))
+      ((= (first lines) "```")
+        (md/-walk
+          (rest lines)
+          (+ i 1)
+          (cons (mk-code (md/-id i) lang (md/-join-nl (reverse body))) acc)))
+      (else
+        (md/-code-collect (rest lines) lang (cons (first lines) body) i acc)))))
+
+(define
+  md/-table-body
+  (fn
+    (lines headers rows i acc)
+    (if
+      (= (len lines) 0)
+      (md/-walk
+        lines
+        (+ i 1)
+        (cons (mk-table (md/-id i) headers (reverse rows)) acc))
+      (let
+        ((line (first lines)))
+        (if
+          (md/-pipe-row? line)
+          (md/-table-body
+            (rest lines)
+            headers
+            (cons (md/-cells line) rows)
+            i
+            acc)
+          (md/-walk
+            lines
+            (+ i 1)
+            (cons (mk-table (md/-id i) headers (reverse rows)) acc)))))))
+(define
+  md/-table
+  (fn
+    (lines i acc)
+    (md/-table-body
+      (rest (rest lines))
+      (md/-cells (first lines))
+      (list)
+      i
+      acc)))
+
+(define
+  md/-list-collect
+  (fn
+    (lines items i acc ordered)
+    (if
+      (= (len lines) 0)
+      (md/-walk
+        lines
+        (+ i 1)
+        (cons (mk-list (md/-id i) ordered (reverse items)) acc))
+      (let
+        ((line (first lines)))
+        (cond
+          (ordered
+            (if
+              (md/-ol? line)
+              (md/-list-collect
+                (rest lines)
+                (cons (md/-drop-ol line) items)
+                i
+                acc
+                ordered)
+              (md/-walk
+                lines
+                (+ i 1)
+                (cons (mk-list (md/-id i) ordered (reverse items)) acc))))
+          (else
+            (if
+              (md/-ul? line)
+              (md/-list-collect
+                (rest lines)
+                (cons (md/-drop-ul line) items)
+                i
+                acc
+                ordered)
+              (md/-walk
+                lines
+                (+ i 1)
+                (cons (mk-list (md/-id i) ordered (reverse items)) acc)))))))))
+
+(define
+  md/-para-collect
+  (fn
+    (lines parts i acc)
+    (if
+      (= (len lines) 0)
+      (md/-walk
+        lines
+        (+ i 1)
+        (cons (mk-text (md/-id i) (md/-join-sp (reverse parts))) acc))
+      (let
+        ((line (first lines)))
+        (if
+          (md/-plain? line)
+          (md/-para-collect (rest lines) (cons line parts) i acc)
+          (md/-walk
+            lines
+            (+ i 1)
+            (cons (mk-text (md/-id i) (md/-join-sp (reverse parts))) acc)))))))
+
+;; ── main walk ──
+(define
+  md/-walk
+  (fn
+    (lines i acc)
+    (if
+      (= (len lines) 0)
+      (reverse acc)
+      (let
+        ((line (first lines)))
+        (cond
+          ((md/-blank? line) (md/-walk (rest lines) i acc))
+          ((ct-starts-with? line "```") (md/-code lines i acc))
+          ((md/-heading? line)
+            (md/-walk
+              (rest lines)
+              (+ i 1)
+              (cons (md/-heading-block line i) acc)))
+          ((ct-starts-with? line "> ")
+            (md/-walk
+              (rest lines)
+              (+ i 1)
+              (cons (mk-quote (md/-id i) "" (md/-drop line "> ")) acc)))
+          ((md/-hr? line)
+            (md/-walk
+              (rest lines)
+              (+ i 1)
+              (cons (mk-divider (md/-id i)) acc)))
+          ((md/-table-start? lines) (md/-table lines i acc))
+          ((md/-ul? line) (md/-list-collect lines (list) i acc false))
+          ((md/-ol? line) (md/-list-collect lines (list) i acc true))
+          (else (md/-para-collect lines (list) i acc)))))))
+
+(define
+  md/parse
+  (fn (text) (md/-walk (split text (str "\n")) 0 (list))))
+
+;; ── frontmatter (leading --- key: value --- block) ──
+(define
+  md/-frontmatter?
+  (fn (lines) (and (> (len lines) 0) (= (first lines) "---"))))
+(define
+  md/-fm-end
+  (fn
+    (lines i)
+    (cond
+      ((>= i (len lines)) -1)
+      ((= (nth lines i) "---") i)
+      (else (md/-fm-end lines (+ i 1))))))
+(define
+  md/-fm-add
+  (fn
+    (acc line)
+    (let
+      ((parts (split line ":")))
+      (if
+        (< (len parts) 2)
+        acc
+        (let
+          ((key (trim (first parts)))
+            (val (trim (md/-join-with ":" (rest parts)))))
+          (cond
+            ((= key "title") (assoc acc :title val))
+            ((= key "slug") (assoc acc :slug val))
+            ((= key "tags")
+              (assoc acc :tags (map (fn (t) (trim t)) (split val ","))))
+            (else acc)))))))
+(define
+  md/-fm-pairs
+  (fn
+    (lines start end acc)
+    (if
+      (>= start end)
+      acc
+      (md/-fm-pairs
+        lines
+        (+ start 1)
+        end
+        (md/-fm-add acc (nth lines start))))))
+
+;; ── adapter ──
+(define
+  md/import
+  (fn
+    (text doc-id)
+    (let
+      ((lines (split text (str "\n"))))
+      (if
+        (md/-frontmatter? lines)
+        (let
+          ((end (md/-fm-end lines 1)))
+          (if
+            (= end -1)
+            (doc-new doc-id (md/-walk lines 0 (list)))
+            (doc-with-meta
+              (doc-new
+                doc-id
+                (md/-walk
+                  (md/-drop-n lines (+ end 1))
+                  0
+                  (list)))
+              (md/-fm-pairs lines 1 end {}))))
+        (doc-new doc-id (md/-walk lines 0 (list)))))))
+
+(define content/from-markdown md/import)
+(define markdown-adapter {:export (fn (doc) (asMarkdown doc)) :import md/import})

lib/content/media.sx

@@ -0,0 +1,52 @@
+;; content-on-sx — video/audio media block.
+;;
+;; CtMedia holds a `kind` (video/audio) and `src`. Self-contained: answers
+;; asHTML/asSx/asText/asMarkdown: so it composes with the render boundary with no
+;; changes elsewhere. HTML src is htmlEscaped, SX src sxEscaped.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx, render.sx (escapers);
+;; markdown.sx / text.sx for those formats.
+
+(define
+  content-bootstrap-media!
+  (fn
+    ()
+    (begin
+      (st-class-define! "CtMedia" "CtBlock" (list "kind" "src"))
+      (ct-def-method! "CtMedia" "kind" "kind ^ kind")
+      (ct-def-method! "CtMedia" "src" "src ^ src")
+      (ct-def-method! "CtMedia" "type" "type ^ #media")
+      (ct-def-method!
+        "CtMedia"
+        "asHTML"
+        "asHTML ^ '<' , kind , ' src=\"' , src htmlEscaped , '\" controls></' , kind , '>'")
+      (ct-def-method!
+        "CtMedia"
+        "asSx"
+        "asSx ^ '(' , kind , ' :src \"' , src sxEscaped , '\")'")
+      (ct-def-method! "CtMedia" "asText" "asText ^ ''")
+      (ct-def-method!
+        "CtMedia"
+        "asMarkdown:"
+        "asMarkdown: nl ^ '[' , kind , '](' , src , ')'")
+      true)))
+
+(define
+  mk-media
+  (fn
+    (id kind src)
+    (st-iv-set!
+      (st-iv-set!
+        (st-iv-set! (st-make-instance "CtMedia") "id" id)
+        "kind"
+        kind)
+      "src"
+      src)))
+
+(define
+  media?
+  (fn (b) (and (st-instance? b) (= (get b :class) "CtMedia"))))
+(define media-kind (fn (b) (st-send b "kind" (list))))
+
+(define mk-video (fn (id src) (mk-media id "video" src)))
+(define mk-audio (fn (id src) (mk-media id "audio" src)))

lib/content/meta.sx

@@ -0,0 +1,53 @@
+;; content-on-sx — document metadata (title / slug / tags).
+;;
+;; CtDoc carries optional metadata alongside its blocks (ivars declared in
+;; doc.sx). Reads go through message dispatch; setters are copy-on-write
+;; (functional st-iv-set!), consistent with the immutable document model.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx.
+
+;; ── reads ──
+(define doc-title (fn (doc) (st-send doc "title" (list))))
+(define doc-slug (fn (doc) (st-send doc "slug" (list))))
+(define
+  doc-tags
+  (fn
+    (doc)
+    (let ((t (st-send doc "tags" (list)))) (if (= t nil) (list) t))))
+
+(define doc-meta (fn (doc) {:slug (doc-slug doc) :id (doc-id doc) :title (doc-title doc) :tags (doc-tags doc)}))
+
+;; ── copy-on-write setters ──
+(define doc-with-title (fn (doc title) (st-iv-set! doc "title" title)))
+(define doc-with-slug (fn (doc slug) (st-iv-set! doc "slug" slug)))
+(define doc-with-tags (fn (doc tags) (st-iv-set! doc "tags" tags)))
+
+(define
+  doc-add-tag
+  (fn (doc tag) (doc-with-tags doc (append (doc-tags doc) (list tag)))))
+
+;; set several at once: meta is a dict with optional :title :slug :tags
+(define
+  doc-with-meta
+  (fn
+    (doc meta)
+    (let
+      ((d1 (if (has-key? meta :title) (doc-with-title doc (get meta :title)) doc)))
+      (let
+        ((d2 (if (has-key? meta :slug) (doc-with-slug d1 (get meta :slug)) d1)))
+        (if (has-key? meta :tags) (doc-with-tags d2 (get meta :tags)) d2)))))
+
+;; constructor with metadata
+(define
+  doc-new-meta
+  (fn (id blocks meta) (doc-with-meta (doc-new id blocks) meta)))
+
+;; ── content/* facade aliases ──
+(define content/title doc-title)
+(define content/slug doc-slug)
+(define content/tags doc-tags)
+(define content/meta doc-meta)
+(define content/with-title doc-with-title)
+(define content/with-slug doc-with-slug)
+(define content/with-tags doc-with-tags)
+(define content/with-meta doc-with-meta)

lib/content/move.sx

@@ -0,0 +1,128 @@
+;; content-on-sx — block reorder + reparent.
+;;
+;; Relative reorder of top-level blocks (move-before/after/to-front/to-back by
+;; id) plus TREE reparenting: move a block into a section (content/move-into) or
+;; promote a nested block back out to the top level (content/promote). Reparent
+;; ops are tree-wide (the block may start anywhere) and cycle-safe — moving a
+;; block into its own descendant is rejected (no-op), so a section can never
+;; become its own ancestor. No-op if any id is missing. Immutable; composes the
+;; doc.sx list + tree helpers (doc-find-deep / ct-find-id / ct-remove-id /
+;; ct-replace-id / ct-insert-at).
+;;
+;; Requires (loaded by harness): doc.sx.
+
+(define
+  content/move-before
+  (fn
+    (doc id target)
+    (let
+      ((blk (doc-find doc id)))
+      (if
+        (= blk nil)
+        doc
+        (let
+          ((without (ct-remove-id (doc-blocks doc) id)))
+          (let
+            ((idx (ct-index-of without target)))
+            (if
+              (= idx -1)
+              doc
+              (doc-with-blocks doc (ct-insert-at without idx blk)))))))))
+
+(define
+  content/move-after
+  (fn
+    (doc id target)
+    (let
+      ((blk (doc-find doc id)))
+      (if
+        (= blk nil)
+        doc
+        (let
+          ((without (ct-remove-id (doc-blocks doc) id)))
+          (let
+            ((idx (ct-index-of without target)))
+            (if
+              (= idx -1)
+              doc
+              (doc-with-blocks
+                doc
+                (ct-insert-at without (+ idx 1) blk)))))))))
+
+(define
+  content/move-to-front
+  (fn
+    (doc id)
+    (let
+      ((blk (doc-find doc id)))
+      (if
+        (= blk nil)
+        doc
+        (doc-with-blocks doc (cons blk (ct-remove-id (doc-blocks doc) id)))))))
+
+(define
+  content/move-to-back
+  (fn
+    (doc id)
+    (let
+      ((blk (doc-find doc id)))
+      (if
+        (= blk nil)
+        doc
+        (doc-with-blocks
+          doc
+          (append (ct-remove-id (doc-blocks doc) id) (list blk)))))))
+
+;; ── reparent (tree-wide) ──
+;; move block `id` (from anywhere in the tree) to be a child of section
+;; `section-id` at index `i`. No-op if either id is missing, if id = section-id,
+;; or if section-id sits inside id's own subtree (would create a cycle).
+(define
+  content/move-into
+  (fn
+    (doc id section-id i)
+    (let
+      ((blk (doc-find-deep doc id)))
+      (if
+        (= blk nil)
+        doc
+        (if
+          (= (doc-find-deep doc section-id) nil)
+          doc
+          (if
+            (= id section-id)
+            doc
+            (if
+              (= (ct-find-id (list blk) section-id) nil)
+              (let
+                ((without (ct-remove-id (doc-blocks doc) id)))
+                (doc-with-blocks
+                  doc
+                  (ct-replace-id
+                    without
+                    section-id
+                    (fn
+                      (sec)
+                      (let
+                        ((ch (st-iv-get sec "children")))
+                        (if
+                          (list? ch)
+                          (st-iv-set! sec "children" (ct-insert-at ch i blk))
+                          sec))))))
+              doc)))))))
+
+;; promote block `id` (wherever it sits) out to the end of the top level. If it
+;; is already top-level this is a move-to-back. No-op if missing. A section keeps
+;; its whole subtree.
+(define
+  content/promote
+  (fn
+    (doc id)
+    (let
+      ((blk (doc-find-deep doc id)))
+      (if
+        (= blk nil)
+        doc
+        (doc-with-blocks
+          doc
+          (append (ct-remove-id (doc-blocks doc) id) (list blk)))))))

lib/content/normalize.sx

@@ -0,0 +1,49 @@
+;; content-on-sx — document normalization.
+;;
+;; A cleanup pass: drop empty text blocks and empty sections across the tree.
+;; Sections are normalised first, so a section that becomes empty (all children
+;; dropped) is itself dropped. For tidying imported/edited documents. Immutable.
+;; Inline tree handling (no section.sx dep).
+;;
+;; Requires (loaded by harness): block.sx, doc.sx.
+
+(define
+  norm-section?
+  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
+(define
+  norm-empty-text?
+  (fn (b) (and (= (blk-type b) "text") (= (str (blk-get b "text")) ""))))
+(define
+  norm-empty-section?
+  (fn
+    (b)
+    (and
+      (norm-section? b)
+      (let
+        ((ch (st-iv-get b "children")))
+        (or (= ch nil) (= (len ch) 0))))))
+
+(define
+  norm-recurse
+  (fn
+    (b)
+    (if
+      (norm-section? b)
+      (let
+        ((ch (st-iv-get b "children")))
+        (if (list? ch) (st-iv-set! b "children" (norm-blocks ch)) b))
+      b)))
+
+(define
+  norm-keep?
+  (fn
+    (b)
+    (if (norm-empty-text? b) false (if (norm-empty-section? b) false true))))
+
+(define
+  norm-blocks
+  (fn (blocks) (filter norm-keep? (map norm-recurse blocks))))
+
+(define
+  content/normalize
+  (fn (doc) (doc-with-blocks doc (norm-blocks (doc-blocks doc)))))

lib/content/outline.sx

@@ -0,0 +1,34 @@
+;; content-on-sx — nested document outline.
+;;
+;; Builds a hierarchical heading tree from content/headings: each node is
+;; {:id :text :level :children}, where a heading nests under the nearest
+;; preceding heading of a lower level. The structured companion to the flat TOC,
+;; for rendering nested navigation.
+;;
+;; Requires (loaded by harness): query.sx (content/headings).
+
+;; consume a prefix of `hs` forming nodes whose level > minlevel; return
+;; {:nodes ... :rest ...}.
+(define
+  ol-forest
+  (fn
+    (hs minlevel)
+    (if
+      (= (len hs) 0)
+      {:rest (list) :nodes (list)}
+      (let
+        ((h (first hs)))
+        (if
+          (<= (get h :level) minlevel)
+          {:rest hs :nodes (list)}
+          (let
+            ((sub (ol-forest (rest hs) (get h :level))))
+            (let
+              ((node {:id (get h :id) :text (get h :text) :children (get sub :nodes) :level (get h :level)}))
+              (let
+                ((more (ol-forest (get sub :rest) minlevel)))
+                {:rest (get more :rest) :nodes (cons node (get more :nodes))}))))))))
+
+(define
+  content/outline
+  (fn (doc) (get (ol-forest (content/headings doc) 0) :nodes)))

lib/content/page-full.sx

@@ -0,0 +1,23 @@
+;; content-on-sx — SEO-complete HTML page.
+;;
+;; content/page-full extends content/page with a lang attribute and a
+;; <meta name="description"> drawn from the document excerpt (plain text,
+;; truncated). Composes the page, metadata and text layers.
+;;
+;; Requires (loaded by harness): page.sx (ct-html-escape, content/page-title),
+;; text.sx (content/excerpt), render.sx (asHTML).
+
+(define CONTENT-EXCERPT-LEN 160)
+
+(define
+  content/page-full
+  (fn
+    (doc)
+    (str
+      "<!doctype html><html lang=\"en\"><head><meta charset=\"utf-8\"><title>"
+      (ct-html-escape (content/page-title doc))
+      "</title><meta name=\"description\" content=\""
+      (ct-html-escape (content/excerpt doc CONTENT-EXCERPT-LEN))
+      "\"></head><body>"
+      (asHTML doc)
+      "</body></html>")))

lib/content/page.sx

@@ -0,0 +1,26 @@
+;; content-on-sx — full HTML page wrapper.
+;;
+;; content/page composes the metadata + render layers into the shippable
+;; artifact the blog serves: a minimal valid HTML5 document with an escaped
+;; <title> (from doc metadata, falling back to the id) and the rendered blocks
+;; as the body.
+;;
+;; Requires (loaded by harness): doc.sx, render.sx (asHTML + htmlEscaped),
+;; meta.sx (doc-title).
+
+(define ct-html-escape (fn (s) (str (st-send s "htmlEscaped" (list)))))
+
+(define
+  content/page-title
+  (fn (doc) (let ((t (doc-title doc))) (if (= t nil) (doc-id doc) t))))
+
+(define
+  content/page
+  (fn
+    (doc)
+    (str
+      "<!doctype html><html><head><meta charset=\"utf-8\"><title>"
+      (ct-html-escape (content/page-title doc))
+      "</title></head><body>"
+      (asHTML doc)
+      "</body></html>")))

lib/content/query.sx

@@ -0,0 +1,75 @@
+;; content-on-sx — block query + table of contents.
+;;
+;; Collect blocks across the whole tree (descending into sections) by predicate
+;; or type, search them by prose, and derive a table of contents from headings.
+;; Tree detection is inline (class + st-iv-get) so this needs no section.sx.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx, text.sx (asText for search).
+
+(define
+  qry-section?
+  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
+(define
+  qry-tree
+  (fn
+    (blocks)
+    (if
+      (= (len blocks) 0)
+      (list)
+      (let
+        ((b (first blocks)))
+        (append
+          (cons
+            b
+            (if
+              (qry-section? b)
+              (let
+                ((ch (st-iv-get b "children")))
+                (if (list? ch) (qry-tree ch) (list)))
+              (list)))
+          (qry-tree (rest blocks)))))))
+
+(define
+  content/select
+  (fn (doc pred) (filter pred (qry-tree (doc-blocks doc)))))
+
+(define
+  content/select-type
+  (fn (doc type) (content/select doc (fn (b) (= (blk-type b) type)))))
+
+(define
+  content/count-type
+  (fn (doc type) (len (content/select-type doc type))))
+
+(define
+  content/select-ids
+  (fn (doc pred) (map (fn (b) (blk-id b)) (content/select doc pred))))
+
+;; Blocks (tree-wide, excluding section containers) whose own prose contains
+;; `term`. "Prose" is (asText b), so search covers exactly what every block
+;; exposes as text — text/heading/code/quote/callout text, image alt, list
+;; items, table headers+cells — with no separate field list to drift from
+;; asText / find-replace / stats. Case-sensitive substring match.
+(define
+  content/search-text
+  (fn
+    (doc term)
+    (content/select
+      doc
+      (fn
+        (b)
+        (and
+          (not (qry-section? b))
+          (>= (index-of (asText b) term) 0))))))
+
+;; Same search, returning matching block ids in document order.
+(define
+  content/search-text-ids
+  (fn
+    (doc term)
+    (map (fn (b) (blk-id b)) (content/search-text doc term))))
+
+;; table of contents: {:id :level :text} for every heading, in document order.
+(define
+  content/headings
+  (fn (doc) (map (fn (b) {:id (blk-id b) :text (blk-get b "text") :level (blk-get b "level")}) (content/select-type doc "heading"))))

lib/content/render.sx

@@ -0,0 +1,99 @@
+;; 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.
+;;
+;; Escaping happens HERE, at the boundary. asHTML routes text/attrs through
+;; String>>htmlEscaped (& < > "); asSx routes them through String>>sxEscaped
+;; (\ and ") so values cannot break out of an element or an SX string literal.
+
+(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 , '&amp;'] ifFalse: [(c = $<) ifTrue: [out := out , '&lt;'] ifFalse: [(c = $>) ifTrue: [out := out , '&gt;'] ifFalse: [(c = $\") ifTrue: [out := out , '&quot;'] ifFalse: [out := out , c asString]]]]. i := i + 1]. ^ out")
+      (ct-def-method!
+        "String"
+        "sxEscaped"
+        "sxEscaped | 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: [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 sxEscaped , '\")'")
+      (ct-def-method! "CtText" "asSx" "asSx ^ '(p \"' , text sxEscaped , '\")'")
+      (ct-def-method!
+        "CtCode"
+        "asSx"
+        "asSx ^ '(pre (code \"' , text sxEscaped , '\"))'")
+      (ct-def-method!
+        "CtQuote"
+        "asSx"
+        "asSx ^ '(blockquote \"' , text sxEscaped , '\")'")
+      (ct-def-method!
+        "CtImage"
+        "asSx"
+        "asSx ^ '(img :src \"' , src sxEscaped , '\" :alt \"' , alt sxEscaped , '\")'")
+      (ct-def-method!
+        "CtEmbed"
+        "asSx"
+        "asSx ^ '(iframe :src \"' , url sxEscaped , '\")'")
+      (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 sxEscaped , '\")']) , ')'")
+      (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)

lib/content/runs.sx

@@ -0,0 +1,118 @@
+;; 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)))

lib/content/sanitize.sx

@@ -0,0 +1,47 @@
+;; content-on-sx — make a document render-safe by dropping invalid blocks.
+;;
+;; The enforcement counterpart to validate: where content/validate REPORTS id /
+;; field issues, content/sanitize REMOVES the offending blocks so the result can
+;; be rendered/merged without faulting on malformed input (federated or imported
+;; documents that failed validation). Tree-wide: descends into sections, pruning
+;; invalid descendants; a section whose own shell is valid is kept (even if it
+;; ends up empty — that is normalize's job, not sanitize's), but a section whose
+;; own check fails (e.g. children is not a list) is dropped whole.
+;;
+;; Reuses validate's per-block predicate (content/-block-issues), so the set of
+;; "what is invalid" stays single-sourced and can't drift from content/validate.
+;; sanitize addresses per-block id/field validity only; it does NOT resolve
+;; duplicate ids (a cross-block concern with no single right answer), so a
+;; sanitized doc is render-safe but not necessarily content/valid? if the input
+;; carried duplicate ids. Immutable; returns a new document.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx, validate.sx
+;; (content/-block-issues).
+
+(define
+  san-section?
+  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
+
+;; a block is render-safe when it has no id/field issues (validate's own checks)
+(define san-ok? (fn (b) (= (len (content/-block-issues b)) 0)))
+
+;; drop invalid blocks at this level; recurse into surviving sections so invalid
+;; descendants are pruned too.
+(define
+  san-blocks
+  (fn
+    (blocks)
+    (map
+      (fn
+        (b)
+        (if
+          (san-section? b)
+          (let
+            ((ch (st-iv-get b "children")))
+            (if (list? ch) (st-iv-set! b "children" (san-blocks ch)) b))
+          b))
+      (filter san-ok? blocks))))
+
+(define
+  content/sanitize
+  (fn (doc) (doc-with-blocks doc (san-blocks (doc-blocks doc)))))

lib/content/scoreboard.json

@@ -0,0 +1,51 @@
+{
+  "suites": {
+    "block": {"pass": 38, "fail": 0},
+    "doc": {"pass": 40, "fail": 0},
+    "render": {"pass": 42, "fail": 0},
+    "api": {"pass": 32, "fail": 0},
+    "meta": {"pass": 27, "fail": 0},
+    "page": {"pass": 7, "fail": 0},
+    "page-full": {"pass": 4, "fail": 0},
+    "markdown": {"pass": 20, "fail": 0},
+    "runs": {"pass": 36, "fail": 0},
+    "text": {"pass": 20, "fail": 0},
+    "section": {"pass": 25, "fail": 0},
+    "compose": {"pass": 17, "fail": 0},
+    "tree-edit": {"pass": 17, "fail": 0},
+    "move": {"pass": 24, "fail": 0},
+    "block-path": {"pass": 13, "fail": 0},
+    "clone": {"pass": 10, "fail": 0},
+    "query": {"pass": 20, "fail": 0},
+    "toc": {"pass": 8, "fail": 0},
+    "anchor": {"pass": 6, "fail": 0},
+    "outline": {"pass": 14, "fail": 0},
+    "flatten": {"pass": 10, "fail": 0},
+    "transform": {"pass": 12, "fail": 0},
+    "normalize": {"pass": 11, "fail": 0},
+    "find-replace": {"pass": 16, "fail": 0},
+    "stats": {"pass": 17, "fail": 0},
+    "summary": {"pass": 14, "fail": 0},
+    "index": {"pass": 13, "fail": 0},
+    "table": {"pass": 15, "fail": 0},
+    "callout": {"pass": 12, "fail": 0},
+    "media": {"pass": 15, "fail": 0},
+    "data": {"pass": 25, "fail": 0},
+    "wire": {"pass": 11, "fail": 0},
+    "validate": {"pass": 32, "fail": 0},
+    "sanitize": {"pass": 12, "fail": 0},
+    "store": {"pass": 46, "fail": 0},
+    "snapshot": {"pass": 20, "fail": 0},
+    "crdt": {"pass": 34, "fail": 0},
+    "crdt-tree": {"pass": 21, "fail": 0},
+    "crdt-blocks": {"pass": 7, "fail": 0},
+    "crdt-store": {"pass": 14, "fail": 0},
+    "sync": {"pass": 14, "fail": 0},
+    "md-import": {"pass": 38, "fail": 0},
+    "md-doc": {"pass": 12, "fail": 0},
+    "fed": {"pass": 20, "fail": 0}
+  },
+  "total_pass": 861,
+  "total_fail": 0,
+  "total": 861
+}

lib/content/scoreboard.md

@@ -0,0 +1,51 @@
+# content-on-sx Conformance Scoreboard
+
+_Generated by `lib/content/conformance.sh`_
+
+| Suite | Pass | Fail | Total |
+|-------|-----:|-----:|------:|
+| block | 38 | 0 | 38 |
+| doc | 40 | 0 | 40 |
+| render | 42 | 0 | 42 |
+| api | 32 | 0 | 32 |
+| meta | 27 | 0 | 27 |
+| page | 7 | 0 | 7 |
+| page-full | 4 | 0 | 4 |
+| markdown | 20 | 0 | 20 |
+| runs | 36 | 0 | 36 |
+| text | 20 | 0 | 20 |
+| section | 25 | 0 | 25 |
+| compose | 17 | 0 | 17 |
+| tree-edit | 17 | 0 | 17 |
+| move | 24 | 0 | 24 |
+| block-path | 13 | 0 | 13 |
+| clone | 10 | 0 | 10 |
+| query | 20 | 0 | 20 |
+| toc | 8 | 0 | 8 |
+| anchor | 6 | 0 | 6 |
+| outline | 14 | 0 | 14 |
+| flatten | 10 | 0 | 10 |
+| transform | 12 | 0 | 12 |
+| normalize | 11 | 0 | 11 |
+| find-replace | 16 | 0 | 16 |
+| stats | 17 | 0 | 17 |
+| summary | 14 | 0 | 14 |
+| index | 13 | 0 | 13 |
+| table | 15 | 0 | 15 |
+| callout | 12 | 0 | 12 |
+| media | 15 | 0 | 15 |
+| data | 25 | 0 | 25 |
+| wire | 11 | 0 | 11 |
+| validate | 32 | 0 | 32 |
+| sanitize | 12 | 0 | 12 |
+| store | 46 | 0 | 46 |
+| snapshot | 20 | 0 | 20 |
+| crdt | 34 | 0 | 34 |
+| crdt-tree | 21 | 0 | 21 |
+| crdt-blocks | 7 | 0 | 7 |
+| crdt-store | 14 | 0 | 14 |
+| sync | 14 | 0 | 14 |
+| md-import | 38 | 0 | 38 |
+| md-doc | 12 | 0 | 12 |
+| fed | 20 | 0 | 20 |
+| **Total** | **861** | **0** | **861** |

lib/content/section.sx

@@ -0,0 +1,103 @@
+;; content-on-sx — nested block trees (section container).
+;;
+;; CtSection is a block whose ivar `children` is an ordered list of blocks (any
+;; type, including nested sections → arbitrary depth). This turns the document
+;; from a flat sequence into the ordered TREE of the architecture sketch.
+;;
+;; Self-contained: CtSection answers asHTML/asSx/asText/asMarkdown: by folding
+;; its children's renderings — pure polymorphic recursion, so it composes with
+;; the existing render boundary with no changes to block.sx or render.sx. (The
+;; relevant per-block render bootstrap must be loaded for the children.)
+;;
+;; Requires (loaded by harness): block.sx, doc.sx, render.sx (asHTML/asSx);
+;; markdown.sx / text.sx for those formats on children.
+
+(define
+  content-bootstrap-section!
+  (fn
+    ()
+    (begin
+      (st-class-define! "CtSection" "CtBlock" (list "children"))
+      (ct-def-method! "CtSection" "children" "children ^ children")
+      (ct-def-method! "CtSection" "type" "type ^ #section")
+      (ct-def-method!
+        "CtSection"
+        "asHTML"
+        "asHTML ^ '<section>' , (children inject: '' into: [:a :b | a , (b asHTML)]) , '</section>'")
+      (ct-def-method!
+        "CtSection"
+        "asSx"
+        "asSx ^ '(section ' , (children inject: '' into: [:a :b | a , (b asSx)]) , ')'")
+      (ct-def-method!
+        "CtSection"
+        "asText"
+        "asText ^ (children inject: '' into: [:a :b | (b asText = '') ifTrue: [a] ifFalse: [(a = '' ifTrue: [b asText] ifFalse: [a , ' ' , b asText])]])")
+      (ct-def-method!
+        "CtSection"
+        "asMarkdown:"
+        "asMarkdown: nl ^ (children inject: '' into: [:a :b | a , (a = '' ifTrue: [''] ifFalse: [nl , nl]) , (b asMarkdown: nl)])")
+      true)))
+
+(define
+  mk-section
+  (fn
+    (id children)
+    (st-iv-set!
+      (st-iv-set! (st-make-instance "CtSection") "id" id)
+      "children"
+      children)))
+
+(define
+  section?
+  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
+
+(define section-children (fn (sec) (st-send sec "children" (list))))
+
+;; copy-on-write child edits (return a new section)
+(define
+  section-with-children
+  (fn (sec children) (st-iv-set! sec "children" children)))
+(define
+  section-append
+  (fn
+    (sec block)
+    (section-with-children sec (append (section-children sec) (list block)))))
+
+;; ── tree traversal (descends into nested sections) ──
+(define
+  block-deep-find
+  (fn
+    (blocks id)
+    (if
+      (= (len blocks) 0)
+      nil
+      (let
+        ((b (first blocks)))
+        (if
+          (= (blk-id b) id)
+          b
+          (let
+            ((nested (if (section? b) (block-deep-find (section-children b) id) nil)))
+            (if (= nested nil) (block-deep-find (rest blocks) id) nested)))))))
+
+(define doc-deep-find (fn (doc id) (block-deep-find (doc-blocks doc) id)))
+
+(define
+  block-tree-ids
+  (fn
+    (blocks)
+    (if
+      (= (len blocks) 0)
+      (list)
+      (let
+        ((b (first blocks)))
+        (append
+          (cons
+            (blk-id b)
+            (if (section? b) (block-tree-ids (section-children b)) (list)))
+          (block-tree-ids (rest blocks)))))))
+
+(define doc-tree-ids (fn (doc) (block-tree-ids (doc-blocks doc))))
+
+(define block-tree-count (fn (blocks) (len (block-tree-ids blocks))))
+(define doc-tree-count (fn (doc) (len (doc-tree-ids doc))))

lib/content/snapshot.sx

@@ -0,0 +1,90 @@
+;; content-on-sx — snapshot cache over the op-log replay.
+;;
+;; Snapshots are a CACHE, never primary state: the op log stays the source of
+;; truth. A snapshot stores a materialised document at a sequence in the persist
+;; KV; cached reads start from it and replay only the tail of ops, so they return
+;; a document IDENTICAL to a full replay — just faster. Drop the snapshot and
+;; nothing is lost.
+;;
+;; Requires (loaded by harness): store.sx (+ doc.sx, persist event/log/kv/api).
+
+(define content/-snap-key (fn (doc-id) (str "content-snap:" doc-id)))
+
+;; take a snapshot of the current head at the current version. Returns the seq.
+(define
+  content/snapshot!
+  (fn
+    (b doc-id)
+    (let
+      ((seq (content/version-count b doc-id)))
+      (begin (persist/kv-put b (content/-snap-key doc-id) {:doc (content/head b doc-id) :seq seq}) seq))))
+
+(define
+  content/-snapshot
+  (fn
+    (b doc-id)
+    (if
+      (persist/kv-has? b (content/-snap-key doc-id))
+      (persist/kv-get b (content/-snap-key doc-id))
+      nil)))
+
+(define
+  content/snapshot-seq
+  (fn
+    (b doc-id)
+    (let
+      ((s (content/-snapshot b doc-id)))
+      (if (= s nil) 0 (get s :seq)))))
+
+(define
+  content/has-snapshot?
+  (fn (b doc-id) (persist/kv-has? b (content/-snap-key doc-id))))
+
+(define
+  content/drop-snapshot!
+  (fn (b doc-id) (persist/kv-delete b (content/-snap-key doc-id))))
+
+;; ── cached reads (transparent: identical result to store.sx replay) ──
+(define
+  content/-tail-ops
+  (fn
+    (b doc-id from to)
+    (map
+      (fn (ev) (persist/event-data ev))
+      (filter
+        (fn
+          (ev)
+          (and
+            (> (persist/event-seq ev) from)
+            (<= (persist/event-seq ev) to)))
+        (content/log b doc-id)))))
+
+(define
+  content/head-cached
+  (fn
+    (b doc-id)
+    (let
+      ((snap (content/-snapshot b doc-id)))
+      (if
+        (= snap nil)
+        (content/head b doc-id)
+        (doc-apply-all
+          (get snap :doc)
+          (content/-tail-ops
+            b
+            doc-id
+            (get snap :seq)
+            (content/version-count b doc-id)))))))
+
+(define
+  content/at-cached
+  (fn
+    (b doc-id seq)
+    (let
+      ((snap (content/-snapshot b doc-id)))
+      (if
+        (or (= snap nil) (< seq (get snap :seq)))
+        (content/at b doc-id seq)
+        (doc-apply-all
+          (get snap :doc)
+          (content/-tail-ops b doc-id (get snap :seq) seq))))))

lib/content/stats.sx

@@ -0,0 +1,49 @@
+;; content-on-sx — document statistics (word/char/block counts, reading time).
+;;
+;; Counts derive from the plain-text projection (asText, tree-accurate via
+;; section recursion) and a tree block count (inline class check, so this needs
+;; no section.sx). Reading time uses 200 wpm, rounded up.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx, text.sx (asText).
+
+(define
+  ct-words
+  (fn (s) (filter (fn (w) (if (= w "") false true)) (split s " "))))
+
+(define ct-ceil-div (fn (a b) (quotient (+ a (- b 1)) b)))
+
+(define
+  ct-stat-section?
+  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
+(define
+  ct-stat-count
+  (fn
+    (blocks)
+    (if
+      (= (len blocks) 0)
+      0
+      (let
+        ((b (first blocks)))
+        (+
+          (+
+            1
+            (if
+              (ct-stat-section? b)
+              (let
+                ((ch (st-iv-get b "children")))
+                (if (list? ch) (ct-stat-count ch) 0))
+              0))
+          (ct-stat-count (rest blocks)))))))
+
+(define content/word-count (fn (doc) (len (ct-words (asText doc)))))
+(define content/char-count (fn (doc) (string-length (asText doc))))
+(define content/block-count (fn (doc) (ct-stat-count (doc-blocks doc))))
+(define
+  content/reading-minutes
+  (fn
+    (doc)
+    (let
+      ((w (content/word-count doc)))
+      (if (= w 0) 0 (ct-ceil-div w 200)))))
+
+(define content/stats (fn (doc) {:blocks (content/block-count doc) :reading-minutes (content/reading-minutes doc) :words (content/word-count doc) :chars (content/char-count doc)}))

lib/content/store.sx

@@ -0,0 +1,110 @@
+;; content-on-sx — op log + versioning over the persist event stream.
+;;
+;; The op log is the source of truth. Editing a document = appending the edit op
+;; as a persist event to the document's stream. Any version of the document is a
+;; replay of its op stream up to a sequence number; the materialised doc is a
+;; cache, never primary state.
+;;
+;; Requires (loaded by the harness): block.sx, doc.sx, section.sx (doc-deep-find
+;; + doc-tree-ids, for the tree-wide diff), plus persist (event/backend/log/kv/
+;; api). The persist backend `b` is opened by the caller via (persist/open) and
+;; injected — content knows nothing about which backend.
+
+(define content/-stream (fn (doc-id) (str "content:" doc-id)))
+
+;; ── commit: append an edit op as an event. `at` is a caller-supplied logical
+;; timestamp (Date.now is unavailable in-kernel). Returns the stored event. ──
+(define
+  content/commit!
+  (fn
+    (b doc-id op at)
+    (persist/append b (content/-stream doc-id) (get op :op) at op)))
+
+(define
+  content/commit-all!
+  (fn
+    (b doc-id ops at)
+    (if
+      (= (len ops) 0)
+      nil
+      (begin
+        (content/commit! b doc-id (first ops) at)
+        (content/commit-all! b doc-id (rest ops) at)))))
+
+;; ── read the raw log / op stream ──
+(define
+  content/log
+  (fn (b doc-id) (persist/read b (content/-stream doc-id))))
+
+(define
+  content/ops
+  (fn
+    (b doc-id)
+    (map (fn (ev) (persist/event-data ev)) (content/log b doc-id))))
+
+;; logical version count (highest seq assigned, survives compaction)
+(define
+  content/version-count
+  (fn (b doc-id) (persist/last-seq b (content/-stream doc-id))))
+
+;; ── replay ──
+;; head — materialise the latest document by folding all ops.
+(define
+  content/head
+  (fn (b doc-id) (doc-apply-all (doc-empty doc-id) (content/ops b doc-id))))
+
+;; at — materialise the document as of sequence `seq` (a version).
+(define
+  content/at
+  (fn
+    (b doc-id seq)
+    (let
+      ((evs (filter (fn (ev) (<= (persist/event-seq ev) seq)) (content/log b doc-id))))
+      (doc-apply-all
+        (doc-empty doc-id)
+        (map (fn (ev) (persist/event-data ev)) evs)))))
+
+;; ── history: per-version metadata, oldest-first ──
+(define
+  content/history
+  (fn (b doc-id) (map (fn (ev) {:type (persist/event-type ev) :at (persist/event-at ev) :seq (persist/event-seq ev)}) (content/log b doc-id))))
+
+;; ── diff between two materialised document versions ──
+;; Tree-wide: ids are enumerated across the whole block tree (descending into
+;; sections), so nested-block adds/removes/changes are detected, not just
+;; top-level ones. Returns {:added :removed :changed} (lists of ids):
+;;   :added   — ids present (anywhere) in `new` but not in `old`
+;;   :removed — ids present (anywhere) in `old` but not in `new`
+;;   :changed — content blocks present in both whose block value differs
+;; Section containers never appear in :changed (they hold no own content — a
+;; child change surfaces as that child's own entry); a whole section appearing
+;; or disappearing shows up in :added / :removed by its id.
+(define content/-all-ids (fn (doc) (doc-tree-ids doc)))
+
+(define content/-missing? (fn (doc id) (= (doc-deep-find doc id) nil)))
+
+(define
+  content/-changed
+  (fn
+    (old new)
+    (filter
+      (fn
+        (id)
+        (let
+          ((bo (doc-deep-find old id)) (bn (doc-deep-find new id)))
+          (cond
+            ((= bo nil) false)
+            ((= bn nil) false)
+            ((= (blk-type bo) "section") false)
+            ((= bo bn) false)
+            (else true))))
+      (content/-all-ids old))))
+
+(define content/diff (fn (old new) {:changed (content/-changed old new) :removed (filter (fn (id) (content/-missing? new id)) (content/-all-ids old)) :added (filter (fn (id) (content/-missing? old id)) (content/-all-ids new))}))
+
+;; convenience: diff two persisted versions by seq.
+(define
+  content/diff-versions
+  (fn
+    (b doc-id seq-a seq-b)
+    (content/diff (content/at b doc-id seq-a) (content/at b doc-id seq-b))))

lib/content/summary.sx

@@ -0,0 +1,26 @@
+;; content-on-sx — list-card summary projection.
+;;
+;; content/summary returns a one-call projection for index/listing cards:
+;;   {:id :title :excerpt :words :reading-minutes :cover}
+;; composing the metadata, text, stats and query layers. `cover` is the first
+;; image's src (or nil).
+;;
+;; Requires (loaded by harness): doc.sx, meta.sx (doc-title), text.sx
+;; (content/excerpt), stats.sx (word-count/reading), query.sx (select-type).
+
+(define
+  content/summary-title
+  (fn (doc) (let ((t (doc-title doc))) (if (= t nil) (doc-id doc) t))))
+
+(define
+  content/cover
+  (fn
+    (doc)
+    (let
+      ((imgs (content/select-type doc "image")))
+      (if
+        (= (len imgs) 0)
+        nil
+        (str (blk-get (first imgs) "src"))))))
+
+(define content/summary (fn (doc) {:id (doc-id doc) :reading-minutes (content/reading-minutes doc) :words (content/word-count doc) :title (content/summary-title doc) :excerpt (content/excerpt doc 160) :cover (content/cover doc)}))

lib/content/sync.sx

@@ -0,0 +1,74 @@
+;; content-on-sx — external CMS sync via an injected adapter.
+;;
+;; Sync is a peripheral, not a feature. The core defines a SHAPE — an adapter is
+;; a dict {:import (fn external doc-id -> doc) :export (fn doc -> external)} — and
+;; delegates to it. The core knows nothing about Ghost's data model; all
+;; translation lives in the adapter. Swap the adapter and the core is unchanged;
+;; if Ghost goes away, nothing here does.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx.
+
+;; ── generic boundary: pure delegation ──
+(define
+  content/import
+  (fn (adapter external doc-id) ((get adapter :import) external doc-id)))
+
+(define content/export (fn (adapter doc) ((get adapter :export) doc)))
+
+;; round-trip a document through an adapter (export then import).
+(define
+  content/round-trip
+  (fn
+    (adapter doc)
+    (content/import adapter (content/export adapter doc) (doc-id doc))))
+
+;; ── a Ghost-flavoured adapter (the peripheral). Ghost knowledge is confined
+;; here: a post is {:title :sections (list section)}; a section is a tagged dict
+;; {:kind ...} that this adapter maps to/from content blocks. ──
+(define
+  ghost-section->block
+  (fn
+    (sec)
+    (let
+      ((kind (get sec :kind)) (id (get sec :id)))
+      (cond
+        ((= kind "heading")
+          (mk-heading id (get sec :level) (get sec :text)))
+        ((= kind "paragraph") (mk-text id (get sec :text)))
+        ((= kind "image") (mk-image id (get sec :src) (get sec :alt)))
+        ((= kind "code") (mk-code id (get sec :language) (get sec :text)))
+        ((= kind "quote") (mk-quote id (get sec :cite) (get sec :text)))
+        ((= kind "hr") (mk-divider id))
+        ((= kind "list") (mk-list id (get sec :ordered) (get sec :items)))
+        ((= kind "embed") (mk-embed id (get sec :url) (get sec :provider)))
+        (else (mk-text id (get sec :text)))))))
+
+(define
+  block->ghost-section
+  (fn
+    (b)
+    (let
+      ((t (blk-type b)) (id (blk-id b)))
+      (cond
+        ((= t "heading") {:id id :text (str (blk-send b "text")) :kind "heading" :level (blk-send b "level")})
+        ((= t "text") {:id id :text (str (blk-send b "text")) :kind "paragraph"})
+        ((= t "image") {:id id :src (str (blk-send b "src")) :alt (str (blk-send b "alt")) :kind "image"})
+        ((= t "code") {:id id :text (str (blk-send b "text")) :kind "code" :language (str (blk-send b "language"))})
+        ((= t "quote") {:cite (str (blk-send b "cite")) :id id :text (str (blk-send b "text")) :kind "quote"})
+        ((= t "divider") {:id id :kind "hr"})
+        ((= t "list") {:items (blk-send b "items") :id id :kind "list" :ordered (blk-send b "ordered")})
+        ((= t "embed") {:id id :provider (str (blk-send b "provider")) :kind "embed" :url (str (blk-send b "url"))})
+        (else {:id id :text "" :kind "paragraph"})))))
+
+(define
+  ghost-import
+  (fn
+    (post doc-id)
+    (st-iv-set!
+      (doc-new doc-id (map ghost-section->block (get post :sections)))
+      "title"
+      (get post :title))))
+
+(define ghost-export (fn (doc) {:sections (map block->ghost-section (doc-blocks doc)) :title (st-send doc "title" (list))}))
+
+(define ghost-adapter {:export ghost-export :import ghost-import})

lib/content/table.sx

@@ -0,0 +1,54 @@
+;; 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))))

lib/content/tests/anchor.sx

@@ -0,0 +1,58 @@
+;; Extension — anchored-heading HTML render (functional TOC links).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append (doc-empty "d") (mk-heading "intro" 1 "Intro"))
+      (mk-text "p" "Body"))
+    (mk-section
+      "s"
+      (list (mk-heading "sub" 2 "Sub") (mk-text "n" "nested")))))
+
+;; ── headings get id anchors; other blocks unchanged ──
+(content-test
+  "anchored html"
+  (content/html-anchored d)
+  "<h1 id=\"intro\">Intro</h1><p>Body</p><section><h2 id=\"sub\">Sub</h2><p>nested</p></section>")
+
+;; ── heading text escaped ──
+(content-test
+  "anchored escapes text"
+  (content/html-anchored
+    (doc-append (doc-empty "d") (mk-heading "h" 2 "A < B")))
+  "<h2 id=\"h\">A &lt; B</h2>")
+
+;; ── non-heading-only doc identical to asHTML ──
+(define
+  np
+  (doc-append
+    (doc-append (doc-empty "d") (mk-text "p" "x"))
+    (mk-image "i" "/a.png" "alt")))
+(content-test "no headings == asHTML" (content/html-anchored np) (asHTML np))
+
+;; ── empty doc ──
+(content-test "anchored empty" (content/html-anchored (doc-empty "e")) "")
+
+;; ── anchors match TOC ids (end-to-end) ──
+(content-test
+  "anchor ids match toc"
+  (map (fn (h) (get h :id)) (content/headings d))
+  (list "intro" "sub"))
+
+;; ── deep nesting ──
+(define
+  deep
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "o"
+      (list (mk-section "i" (list (mk-heading "deep" 3 "Deep")))))))
+(content-test
+  "deep anchored"
+  (content/html-anchored deep)
+  "<section><section><h3 id=\"deep\">Deep</h3></section></section>")

lib/content/tests/api.sx

@@ -0,0 +1,133 @@
+;; Phase 1 — public API facade. End-to-end through content/*.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+
+;; ── build a document via the facade ──
+(define d0 (content/empty "post"))
+(define
+  h
+  (content/block
+    "heading"
+    "h"
+    (list (list "level" 1) (list "text" "Hi"))))
+(define p (content/block "text" "p" (list (list "text" "World"))))
+(define d1 (content/append (content/append d0 h) p))
+
+(content/op? (content/insert h nil))
+(content-test "count" (content/count d1) 2)
+(content-test "ids" (content/ids d1) (list "h" "p"))
+(content-test "types" (content/types d1) (list "heading" "text"))
+(content-test "find" (blk-id (content/find d1 "p")) "p")
+(content-test "has? yes" (content/has? d1 "h") true)
+(content-test "has? no" (content/has? d1 "x") false)
+
+;; ── content/op? distinguishes a single op from a list / a block ──
+(content-test "op? on insert" (content/op? (content/insert h nil)) true)
+(content-test
+  "op? on update"
+  (content/op? (content/update "p" "text" "z"))
+  true)
+(content-test "op? on list" (content/op? (list (content/delete "h"))) false)
+(content-test "op? on block" (content/op? h) false)
+(content-test "op? on doc" (content/op? d1) false)
+
+;; ── edit with a single op ──
+(define
+  img
+  (content/block
+    "image"
+    "img"
+    (list (list "src" "/c.png") (list "alt" "cat"))))
+(define d2 (content/edit d1 (content/insert img "h")))
+(content-test "edit single op order" (content/ids d2) (list "h" "img" "p"))
+(content-test "edit single immutable" (content/ids d1) (list "h" "p"))
+(content-test
+  "edit update"
+  (str
+    (blk-send
+      (content/find
+        (content/edit d1 (content/update "p" "text" "Edited"))
+        "p")
+      "text"))
+  "Edited")
+(content-test
+  "edit delete"
+  (content/ids (content/edit d1 (content/delete "h")))
+  (list "p"))
+(content-test
+  "edit move"
+  (content/ids (content/edit d1 (content/move "p" 0)))
+  (list "p" "h"))
+
+;; ── edit with a stream of ops ──
+(define ops (list (content/insert img "h") (content/delete "p")))
+(content-test
+  "edit op stream"
+  (content/ids (content/edit d1 ops))
+  (list "h" "img"))
+(content-test "edit op stream immutable" (content/ids d1) (list "h" "p"))
+
+;; ── render via facade ──
+(content-test
+  "render html"
+  (content/render d1 "html")
+  "<h1>Hi</h1><p>World</p>")
+(content-test
+  "render sx"
+  (content/render d1 "sx")
+  "(article (h1 \"Hi\")(p \"World\"))")
+(content-test
+  "render html keyword"
+  (content/render d1 :html)
+  "<h1>Hi</h1><p>World</p>")
+(content-test
+  "render sx keyword"
+  (content/render d1 :sx)
+  "(article (h1 \"Hi\")(p \"World\"))")
+(content-test "content/html" (content/html d1) "<h1>Hi</h1><p>World</p>")
+(content-test "content/sx" (content/sx d1) "(article (h1 \"Hi\")(p \"World\"))")
+
+;; ── render reflects each version ──
+(content-test
+  "render edited version"
+  (content/render (content/edit d1 (content/update "h" "text" "Hey")) "html")
+  "<h1>Hey</h1><p>World</p>")
+(content-test
+  "render original unchanged"
+  (content/render d1 "html")
+  "<h1>Hi</h1><p>World</p>")
+
+;; ── facade find/has? are TREE-WIDE (reach into sections); find-top/has-top?
+;; keep the top-level-only lookup. This makes the read-by-id surface consistent
+;; with content/edit, whose update/delete are already tree-wide. ──
+(content-bootstrap-section!)
+(define
+  nd
+  (content/append
+    (content/empty "nested")
+    (mk-section
+      "sec"
+      (list (content/block "text" "inner" (list (list "text" "deep")))))))
+(content-test
+  "find nested (deep)"
+  (blk-id (content/find nd "inner"))
+  "inner")
+(content-test "has? nested (deep)" (content/has? nd "inner") true)
+(content-test "find-top misses nested" (content/find-top nd "inner") nil)
+(content-test "has-top? misses nested" (content/has-top? nd "inner") false)
+(content-test
+  "find-top sees top-level"
+  (blk-id (content/find-top nd "sec"))
+  "sec")
+;; a nested block updated by id via content/edit is now readable by id via
+;; content/find (was impossible when find was top-level-only).
+(content-test
+  "edit-then-find nested round-trip"
+  (str
+    (blk-send
+      (content/find
+        (content/edit nd (content/update "inner" "text" "edited"))
+        "inner")
+      "text"))
+  "edited")

lib/content/tests/block-path.sx

@@ -0,0 +1,59 @@
+;; Extension — locate a block in the tree (ancestor section path).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+;; doc: top-level "a", section "s" containing "x" and nested section "i"
+;; containing "z".
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-text "a" "A"))
+    (mk-section
+      "s"
+      (list (mk-text "x" "X") (mk-section "i" (list (mk-text "z" "Z")))))))
+
+;; ── block-path ──
+(content-test
+  "top-level block has empty path"
+  (content/block-path d "a")
+  (list))
+(content-test "one-deep block path" (content/block-path d "x") (list "s"))
+(content-test
+  "two-deep block path"
+  (content/block-path d "z")
+  (list "s" "i"))
+(content-test "section's own path" (content/block-path d "i") (list "s"))
+(content-test "missing id path nil" (content/block-path d "zzz") nil)
+
+;; nil (absent) is distinct from () (present top-level)
+(content-test
+  "absent vs top-level distinguishable"
+  (if (= (content/block-path d "a") nil) "nil" "list")
+  "list")
+
+;; ── block-depth ──
+(content-test "depth top-level" (content/block-depth d "a") 0)
+(content-test "depth one" (content/block-depth d "x") 1)
+(content-test "depth two" (content/block-depth d "z") 2)
+(content-test "depth section" (content/block-depth d "i") 1)
+(content-test "depth absent" (content/block-depth d "zzz") -1)
+
+;; ── path tracks reparenting (composes with move.sx) ──
+;; (rebuild expectation directly; move tested elsewhere)
+(define
+  flat
+  (doc-append
+    (doc-append (doc-empty "d") (mk-section "sec" (list)))
+    (mk-text "p" "P")))
+(content-test
+  "before: p at top level"
+  (content/block-depth flat "p")
+  0)
+
+;; ── empty doc ──
+(content-test
+  "empty doc path nil"
+  (content/block-path (doc-empty "e") "x")
+  nil)

lib/content/tests/block.sx

@@ -0,0 +1,75 @@
+;; Phase 1 — typed block objects. Behaviour via message dispatch; fields
+;; immutable (copy-on-write).
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+
+;; ── construction + polymorphic type dispatch ──
+(define h (mk-heading "b1" 2 "Title"))
+(define t (mk-text "b2" "Body text"))
+(define img (mk-image "b3" "/cat.png" "a cat"))
+(define code (mk-code "b4" "sx" "(+ 1 2)"))
+(define q (mk-quote "b5" "Ada" "to err"))
+(define em (mk-embed "b6" "https://v/1" "vimeo"))
+(define dv (mk-divider "b7"))
+(define ls (mk-list "b8" true (list "one" "two")))
+
+(content-test "heading type" (blk-type h) "heading")
+(content-test "text type" (blk-type t) "text")
+(content-test "image type" (blk-type img) "image")
+(content-test "code type" (blk-type code) "code")
+(content-test "quote type" (blk-type q) "quote")
+(content-test "embed type" (blk-type em) "embed")
+(content-test "divider type" (blk-type dv) "divider")
+(content-test "list type" (blk-type ls) "list")
+
+;; ── id via message dispatch ──
+(content-test "heading id" (blk-id h) "b1")
+(content-test "image id" (blk-id img) "b3")
+(content-test "divider id" (blk-id dv) "b7")
+
+;; ── field reads via messages (incl. inherited text) ──
+(content-test "heading text inherited" (str (blk-send h "text")) "Title")
+(content-test "heading level" (blk-send h "level") 2)
+(content-test "text body" (str (blk-send t "text")) "Body text")
+(content-test "image src" (str (blk-send img "src")) "/cat.png")
+(content-test "image alt" (str (blk-send img "alt")) "a cat")
+(content-test "code language" (str (blk-send code "language")) "sx")
+(content-test "code text inherited" (str (blk-send code "text")) "(+ 1 2)")
+(content-test "quote cite" (str (blk-send q "cite")) "Ada")
+(content-test "embed url" (str (blk-send em "url")) "https://v/1")
+(content-test "embed provider" (str (blk-send em "provider")) "vimeo")
+(content-test "list ordered" (blk-send ls "ordered") true)
+(content-test "list items" (blk-send ls "items") (list "one" "two"))
+
+;; ── blk-get reads ivars directly ──
+(content-test "blk-get level" (blk-get h "level") 2)
+(content-test "blk-get missing nil" (blk-get h "nope") nil)
+
+;; ── copy-on-write: blk-set returns a new block, original untouched ──
+(define h2 (blk-set h "level" 1))
+(content-test "blk-set new value" (blk-send h2 "level") 1)
+(content-test "blk-set original unchanged" (blk-send h "level") 2)
+(content-test "blk-set keeps id" (blk-id h2) "b1")
+(content-test "blk-set keeps text" (str (blk-send h2 "text")) "Title")
+
+;; ── predicate ──
+(content-test "block? on heading" (block? h) true)
+(content-test "block? on divider" (block? dv) true)
+(content-test "block? on number" (block? 5) false)
+(content-test "block? on string" (block? "x") false)
+
+;; ── isBlock message inherited by all ──
+(content-test "isBlock heading" (blk-send h "isBlock") true)
+(content-test "isBlock list" (blk-send ls "isBlock") true)
+
+;; ── generic mk-block via wire tag ──
+(define
+  g
+  (mk-block
+    "heading"
+    "g1"
+    (list (list "level" 3) (list "text" "Gen"))))
+(content-test "mk-block type" (blk-type g) "heading")
+(content-test "mk-block level" (blk-send g "level") 3)
+(content-test "mk-block text" (str (blk-send g "text")) "Gen")

lib/content/tests/callout.sx

@@ -0,0 +1,55 @@
+;; Extension — callout / admonition block.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-text!)
+(content-bootstrap-callout!)
+
+(define c (mk-callout "c" "warning" "Be careful"))
+
+;; ── identity ──
+(content-test "callout is block" (block? c) true)
+(content-test "callout? yes" (callout? c) true)
+(content-test "callout type" (blk-type c) "callout")
+(content-test "callout kind" (callout-kind c) "warning")
+
+;; ── render ──
+(content-test
+  "callout html"
+  (asHTML c)
+  "<aside class=\"callout callout-warning\">Be careful</aside>")
+(content-test
+  "callout sx"
+  (asSx c)
+  "(aside :class \"callout callout-warning\" \"Be careful\")")
+(content-test "callout text" (asText c) "Be careful")
+(content-test "callout markdown" (asMarkdown c) "> **warning:** Be careful")
+
+;; ── html escapes text ──
+(content-test
+  "callout html escapes"
+  (asHTML (mk-callout "c" "note" "a < b"))
+  "<aside class=\"callout callout-note\">a &lt; b</aside>")
+
+;; ── in a document ──
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "T"))
+    c))
+(content-test
+  "doc with callout html"
+  (asHTML d)
+  "<h1>T</h1><aside class=\"callout callout-warning\">Be careful</aside>")
+
+;; ── validation ──
+(content-test
+  "valid callout"
+  (content/valid? (doc-append (doc-empty "d") c))
+  true)
+(content-test
+  "bad callout kind flagged"
+  (content/issue-kinds
+    (doc-append (doc-empty "d") (mk-callout "c" 5 "x")))
+  (list "field"))

lib/content/tests/clone.sx

@@ -0,0 +1,55 @@
+;; Extension — block id remapping / clone.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "Title"))
+    (mk-section "s" (list (mk-text "a" "A") (mk-text "b" "B")))))
+
+;; ── prefix-ids rewrites every id in the tree ──
+(define p (content/prefix-ids d "x-"))
+(content-test "prefix top-level ids" (doc-ids p) (list "x-h" "x-s"))
+(content-test
+  "prefix tree-ids"
+  (doc-tree-ids p)
+  (list "x-h" "x-s" "x-a" "x-b"))
+(content-test "prefix immutable" (doc-tree-ids d) (list "h" "s" "a" "b"))
+(content-test "prefix preserves content" (asHTML p) (asHTML d))
+(content-test
+  "prefix preserves nested content"
+  (str (blk-send (doc-deep-find p "x-a") "text"))
+  "A")
+
+;; ── custom remap fn ──
+(define u (content/remap-ids d (fn (id) (str id "!"))))
+(content-test "remap suffix" (doc-tree-ids u) (list "h!" "s!" "a!" "b!"))
+
+;; ── collision-free composition ──
+(define
+  d2
+  (doc-append (doc-empty "d2") (mk-heading "h" 2 "Other")))
+(define
+  combined
+  (content/concat
+    (content/prefix-ids d "left-")
+    (content/prefix-ids d2 "right-")))
+(content-test
+  "combined ids unique"
+  (doc-tree-ids combined)
+  (list "left-h" "left-s" "left-a" "left-b" "right-h"))
+(content-test "combined validates" (content/valid? combined) true)
+;; without prefixing, the shared id "h" collides
+(content-test
+  "unprefixed collides"
+  (content/valid? (content/concat d d2))
+  false)
+
+;; ── render of combined ──
+(content-test
+  "combined render"
+  (asHTML combined)
+  "<h1>Title</h1><section><p>A</p><p>B</p></section><h2>Other</h2>")

lib/content/tests/compose.sx

@@ -0,0 +1,76 @@
+;; Extension — document composition.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+(define
+  a
+  (doc-with-title
+    (doc-append (doc-empty "a") (mk-heading "h" 1 "A"))
+    "Doc A"))
+(define
+  b
+  (doc-append
+    (doc-append (doc-empty "b") (mk-text "p" "B1"))
+    (mk-text "q" "B2")))
+
+;; ── concat ──
+(define ab (content/concat a b))
+(content-test "concat ids" (doc-ids ab) (list "h" "p" "q"))
+(content-test "concat keeps first id" (doc-id ab) "a")
+(content-test "concat keeps first title" (doc-title ab) "Doc A")
+(content-test "concat immutable a" (doc-ids a) (list "h"))
+(content-test "concat immutable b" (doc-ids b) (list "p" "q"))
+
+;; ── prepend ──
+(define ba (content/prepend a b))
+(content-test "prepend ids" (doc-ids ba) (list "p" "q" "h"))
+(content-test "prepend keeps a id" (doc-id ba) "a")
+
+;; ── concat with empty ──
+(content-test
+  "concat empty right"
+  (doc-ids (content/concat a (doc-empty "e")))
+  (list "h"))
+(content-test
+  "concat empty left"
+  (doc-ids (content/concat (doc-empty "e") b))
+  (list "p" "q"))
+
+;; ── concat-all ──
+(define c (doc-append (doc-empty "c") (mk-divider "d")))
+(content-test
+  "concat-all order"
+  (doc-ids (content/concat-all (list a b c)))
+  (list "h" "p" "q" "d"))
+(content-test
+  "concat-all keeps first id"
+  (doc-id (content/concat-all (list a b c)))
+  "a")
+(content-test
+  "concat-all single"
+  (doc-ids (content/concat-all (list a)))
+  (list "h"))
+(content-test
+  "concat-all empty"
+  (doc-ids (content/concat-all (list)))
+  (list))
+
+;; ── render of composed doc ──
+(content-test
+  "composed renders"
+  (asHTML (content/concat a b))
+  "<h1>A</h1><p>B1</p><p>B2</p>")
+
+;; ── wrap-section collapses blocks into a subtree ──
+(define w (content/wrap-section ab "sec"))
+(content-test "wrap top-level is one section" (doc-ids w) (list "sec"))
+(content-test
+  "wrap children preserved"
+  (doc-tree-ids w)
+  (list "sec" "h" "p" "q"))
+(content-test
+  "wrap renders nested"
+  (asHTML w)
+  "<section><h1>A</h1><p>B1</p><p>B2</p></section>")

lib/content/tests/crdt-blocks.sx

@@ -0,0 +1,136 @@
+;; Hardening — non-core block types (callout/table/media/section) survive the
+;; flat and tree CvRDT materialise paths (regression for the ct-class-for-type
+;; fix: these route through crdt-element->block -> mk-block).
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-render!)
+(content-bootstrap-section!)
+(content-bootstrap-callout!)
+(content-bootstrap-table!)
+(content-bootstrap-media!)
+
+;; ── flat CRDT: callout / table / media leaves ──
+(define
+  s
+  (crdt-apply-all
+    (crdt-empty)
+    (list
+      (crdt-op-insert
+        "co"
+        "callout"
+        (crdt-pos 1 0)
+        (list (list "kind" "note") (list "text" "hi"))
+        1
+        0)
+      (crdt-op-insert
+        "tb"
+        "table"
+        (crdt-pos 2 0)
+        (list (list "headers" (list "A")) (list "rows" (list (list "1"))))
+        1
+        0)
+      (crdt-op-insert
+        "vid"
+        "media"
+        (crdt-pos 3 0)
+        (list (list "kind" "video") (list "src" "/v.mp4"))
+        1
+        0))))
+(content-test
+  "flat crdt callout render"
+  (asHTML (crdt-materialize "d" s))
+  "<aside class=\"callout callout-note\">hi</aside><table><thead><tr><th>A</th></tr></thead><tbody><tr><td>1</td></tr></tbody></table><video src=\"/v.mp4\" controls></video>")
+(content-test "flat crdt order" (crdt-order s) (list "co" "tb" "vid"))
+
+;; ── flat CRDT: callout field via LWW update ──
+(define s2 (crdt-update s "co" "text" "edited" 5 1))
+(content-test
+  "flat crdt callout update"
+  (str (blk-send (doc-find (crdt-materialize "d" s2) "co") "text"))
+  "edited")
+
+;; ── tree CRDT: callout/table inside a section ──
+(define
+  t
+  (crdt-tree-apply-all
+    (crdt-empty)
+    (list
+      (crdt-tree-op-insert
+        "sec"
+        "section"
+        (crdt-pos 1 0)
+        ""
+        (list)
+        1
+        0)
+      (crdt-tree-op-insert
+        "co"
+        "callout"
+        (crdt-pos 1 0)
+        "sec"
+        (list (list "kind" "tip") (list "text" "T"))
+        1
+        0)
+      (crdt-tree-op-insert
+        "tb"
+        "table"
+        (crdt-pos 2 0)
+        "sec"
+        (list (list "headers" (list "H")) (list "rows" (list)))
+        1
+        0))))
+(content-test
+  "tree crdt nested blocks"
+  (doc-tree-ids (crdt-tree-materialize "d" t))
+  (list "sec" "co" "tb"))
+(content-test
+  "tree crdt nested render"
+  (asHTML (crdt-tree-materialize "d" t))
+  "<section><aside class=\"callout callout-tip\">T</aside><table><thead><tr><th>H</th></tr></thead><tbody></tbody></table></section>")
+
+;; ── tree CRDT: concurrent callout inserts into a section converge ──
+(define
+  base
+  (crdt-tree-insert
+    (crdt-empty)
+    "sec"
+    "section"
+    (crdt-pos 1 0)
+    ""
+    (list)
+    1
+    0))
+(define
+  rA
+  (crdt-tree-insert
+    base
+    "x"
+    "callout"
+    (crdt-pos 5 1)
+    "sec"
+    (list (list "kind" "note") (list "text" "A"))
+    2
+    1))
+(define
+  rB
+  (crdt-tree-insert
+    base
+    "y"
+    "media"
+    (crdt-pos 5 2)
+    "sec"
+    (list (list "kind" "audio") (list "src" "/a.mp3"))
+    2
+    2))
+(content-test
+  "tree crdt mixed converge"
+  (=
+    (get (crdt-tree-merge rA rB) :elements)
+    (get (crdt-tree-merge rB rA) :elements))
+  true)
+(content-test
+  "tree crdt mixed ids"
+  (doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-merge rA rB)))
+  (list "sec" "x" "y"))

lib/content/tests/crdt-store.sx

@@ -0,0 +1,139 @@
+;; Extension — durable collaborative replication (CRDT ops on persist).
+;; Replicas log independently; converge merges the logs deterministically.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-render!)
+
+(define same? (fn (a b) (= (get a :elements) (get b :elements))))
+(define B (persist/open))
+
+;; replica "a" (origin): inserts h, p
+(crdt/commit!
+  B
+  "doc"
+  "a"
+  (crdt-op-insert
+    "h"
+    "heading"
+    (crdt-pos 1 0)
+    (list (list "level" 1) (list "text" "T"))
+    1
+    1)
+  1)
+(crdt/commit!
+  B
+  "doc"
+  "a"
+  (crdt-op-insert
+    "p"
+    "text"
+    (crdt-pos 2 0)
+    (list (list "text" "Body"))
+    1
+    1)
+  1)
+
+;; replica "b" (concurrent): edits p, inserts x
+(crdt/commit-all!
+  B
+  "doc"
+  "b"
+  (list
+    (crdt-op-update "p" "text" "Edited" 5 2)
+    (crdt-op-insert
+      "x"
+      "text"
+      (crdt-pos 3 0)
+      (list (list "text" "X"))
+      6
+      2))
+  5)
+
+;; ── durability ──
+(content-test
+  "replica a version"
+  (crdt/replica-version B "doc" "a")
+  2)
+(content-test
+  "replica b version"
+  (crdt/replica-version B "doc" "b")
+  2)
+(content-test
+  "replica a ops len"
+  (len (crdt/replica-ops B "doc" "a"))
+  2)
+
+;; ── single-replica replay ──
+(content-test
+  "replay a order"
+  (crdt-order (crdt/replay B "doc" "a"))
+  (list "h" "p"))
+(content-test
+  "replay a == apply-all"
+  (same?
+    (crdt/replay B "doc" "a")
+    (crdt-apply-all (crdt-empty) (crdt/replica-ops B "doc" "a")))
+  true)
+
+;; ── converge ──
+(content-test
+  "converge order"
+  (crdt/order B "doc" (list "a" "b"))
+  (list "h" "p" "x"))
+(content-test
+  "converge replica-order-independent"
+  (same?
+    (crdt/converge B "doc" (list "a" "b"))
+    (crdt/converge B "doc" (list "b" "a")))
+  true)
+(content-test
+  "converge LWW p edited"
+  (str
+    (blk-send (doc-find (crdt/document B "doc" (list "a" "b")) "p") "text"))
+  "Edited")
+(content-test
+  "converged document render"
+  (asHTML (crdt/document B "doc" (list "a" "b")))
+  "<h1>T</h1><p>Edited</p><p>X</p>")
+
+;; ── duplicate delivery is idempotent ──
+(crdt/commit!
+  B
+  "doc"
+  "a"
+  (crdt-op-insert
+    "p"
+    "text"
+    (crdt-pos 2 0)
+    (list (list "text" "Body"))
+    1
+    1)
+  1)
+(content-test
+  "duplicate op no effect on converge"
+  (crdt/order B "doc" (list "a" "b"))
+  (list "h" "p" "x"))
+(content-test
+  "duplicate keeps LWW value"
+  (str
+    (blk-send (doc-find (crdt/document B "doc" (list "a" "b")) "p") "text"))
+  "Edited")
+
+;; ── new op on a replica is reflected after re-converge ──
+(crdt/commit! B "doc" "b" (crdt-op-delete "h") 9)
+(content-test
+  "delete reflected after reconverge"
+  (crdt/order B "doc" (list "a" "b"))
+  (list "p" "x"))
+
+;; ── isolation: unknown doc converges to empty ──
+(content-test
+  "unknown doc empty"
+  (crdt/order B "other" (list "a" "b"))
+  (list))
+(content-test
+  "unknown replica empty ops"
+  (len (crdt/replica-ops B "doc" "zzz"))
+  0)

lib/content/tests/crdt-tree.sx

@@ -0,0 +1,289 @@
+;; Extension — nested-tree CvRDT. Sections nest and merge collaboratively;
+;; convergence is order/replica/duplicate-insensitive like the flat layer.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-render!)
+(content-bootstrap-section!)
+
+(define same? (fn (a b) (= (get a :elements) (get b :elements))))
+
+;; base: a section "s" at root, with one child heading.
+(define
+  base
+  (crdt-tree-insert
+    (crdt-tree-insert
+      (crdt-empty)
+      "s"
+      "section"
+      (crdt-pos 1 0)
+      ""
+      (list)
+      1
+      0)
+    "h"
+    "heading"
+    (crdt-pos 1 0)
+    "s"
+    (list (list "level" 2) (list "text" "Sub"))
+    1
+    0))
+
+;; ── materialise rebuilds the tree ──
+(content-test "tree order root" (crdt-tree-order base) (list "s"))
+(content-test
+  "tree materialize ids"
+  (doc-tree-ids (crdt-tree-materialize "d" base))
+  (list "s" "h"))
+(content-test
+  "tree render"
+  (asHTML (crdt-tree-materialize "d" base))
+  "<section><h2>Sub</h2></section>")
+
+;; ── concurrent inserts into the SAME section converge + order by pos ──
+(define
+  rA
+  (crdt-tree-insert
+    base
+    "a"
+    "text"
+    (crdt-pos 5 1)
+    "s"
+    (list (list "text" "A"))
+    2
+    1))
+(define
+  rB
+  (crdt-tree-insert
+    base
+    "b"
+    "text"
+    (crdt-pos 5 2)
+    "s"
+    (list (list "text" "B"))
+    2
+    2))
+(content-test
+  "same-parent merge commutes"
+  (same? (crdt-tree-merge rA rB) (crdt-tree-merge rB rA))
+  true)
+(content-test
+  "same-parent order deterministic"
+  (doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-merge rA rB)))
+  (list "s" "h" "a" "b"))
+
+;; ── concurrent inserts into DIFFERENT parents converge ──
+(define
+  base2
+  (crdt-tree-insert
+    (crdt-tree-insert
+      (crdt-empty)
+      "s1"
+      "section"
+      (crdt-pos 1 0)
+      ""
+      (list)
+      1
+      0)
+    "s2"
+    "section"
+    (crdt-pos 2 0)
+    ""
+    (list)
+    1
+    0))
+(define
+  x
+  (crdt-tree-insert
+    base2
+    "x"
+    "text"
+    (crdt-pos 1 0)
+    "s1"
+    (list (list "text" "X"))
+    2
+    1))
+(define
+  y
+  (crdt-tree-insert
+    base2
+    "y"
+    "text"
+    (crdt-pos 1 0)
+    "s2"
+    (list (list "text" "Y"))
+    2
+    2))
+(define m (crdt-tree-merge x y))
+(content-test
+  "different-parent commutes"
+  (same? m (crdt-tree-merge y x))
+  true)
+(content-test
+  "different-parent tree"
+  (doc-tree-ids (crdt-tree-materialize "d" m))
+  (list "s1" "x" "s2" "y"))
+(content-test
+  "different-parent render"
+  (asHTML (crdt-tree-materialize "d" m))
+  "<section><p>X</p></section><section><p>Y</p></section>")
+
+;; ── nested sections (section inside section) ──
+(define
+  nested
+  (crdt-tree-apply-all
+    (crdt-empty)
+    (list
+      (crdt-tree-op-insert
+        "outer"
+        "section"
+        (crdt-pos 1 0)
+        ""
+        (list)
+        1
+        0)
+      (crdt-tree-op-insert
+        "inner"
+        "section"
+        (crdt-pos 1 0)
+        "outer"
+        (list)
+        1
+        0)
+      (crdt-tree-op-insert
+        "leaf"
+        "text"
+        (crdt-pos 1 0)
+        "inner"
+        (list (list "text" "deep"))
+        1
+        0))))
+(content-test
+  "nested tree ids"
+  (doc-tree-ids (crdt-tree-materialize "d" nested))
+  (list "outer" "inner" "leaf"))
+(content-test
+  "nested render"
+  (asHTML (crdt-tree-materialize "d" nested))
+  "<section><section><p>deep</p></section></section>")
+
+;; ── ops in any order converge (commutative) ──
+(define
+  opA
+  (crdt-tree-op-insert
+    "p"
+    "text"
+    (crdt-pos 6 0)
+    "s"
+    (list (list "text" "P"))
+    3
+    1))
+(define opB (crdt-tree-op-update "h" "text" "Edited" 5 1))
+(define opC (crdt-tree-op-delete "h"))
+(content-test
+  "ops commute"
+  (same?
+    (crdt-tree-apply-all base (list opA opB opC))
+    (crdt-tree-apply-all base (list opC opB opA)))
+  true)
+(content-test
+  "ops idempotent"
+  (same?
+    (crdt-tree-apply-all base (list opA opB))
+    (crdt-tree-apply-all
+      (crdt-tree-apply-all base (list opA opB))
+      (list opA opB)))
+  true)
+
+;; ── update into a section + LWW ──
+(define u1 (crdt-tree-update base "h" "text" "v5" 5 1))
+(define u2 (crdt-tree-update base "h" "text" "v7" 7 2))
+(content-test
+  "tree LWW higher ts"
+  (str
+    (blk-send
+      (doc-deep-find (crdt-tree-materialize "d" (crdt-tree-merge u1 u2)) "h")
+      "text"))
+  "v7")
+
+;; ── delete inside a section ──
+(content-test
+  "delete in section"
+  (doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-delete base "h")))
+  (list "s"))
+
+;; ── merge idempotence ──
+(content-test "merge idempotent self" (same? (crdt-tree-merge m m) m) true)
+
+;; ── full convergence: two replicas, divergent edits in different sections ──
+(define
+  repl1
+  (crdt-tree-apply-all
+    base2
+    (list
+      (crdt-tree-op-insert
+        "p1"
+        "text"
+        (crdt-pos 1 0)
+        "s1"
+        (list (list "text" "from1"))
+        5
+        1))))
+(define
+  repl2
+  (crdt-tree-apply-all
+    base2
+    (list
+      (crdt-tree-op-insert
+        "p2"
+        "text"
+        (crdt-pos 1 0)
+        "s2"
+        (list (list "text" "from2"))
+        6
+        2))))
+(content-test
+  "two-replica tree converges"
+  (same? (crdt-tree-merge repl1 repl2) (crdt-tree-merge repl2 repl1))
+  true)
+(content-test
+  "two-replica tree ids"
+  (doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-merge repl1 repl2)))
+  (list "s1" "p1" "s2" "p2"))
+
+;; ── orphan reparenting: concurrent delete-section + insert-child ──
+;; A deletes section s; B inserts a child into s. After merge, s is gone but the
+;; child must survive (reparented to root), not silently vanish.
+(define delA (crdt-tree-delete base "s"))
+(define
+  insB
+  (crdt-tree-insert
+    base
+    "c"
+    "text"
+    (crdt-pos 9 0)
+    "s"
+    (list (list "text" "kept"))
+    5
+    2))
+(define orphan-merge (crdt-tree-merge delA insB))
+(content-test
+  "orphan survives delete-section"
+  (doc-tree-ids (crdt-tree-materialize "d" orphan-merge))
+  (list "h" "c"))
+(content-test
+  "orphan reparent commutes"
+  (same? orphan-merge (crdt-tree-merge insB delA))
+  true)
+(content-test
+  "orphan content preserved"
+  (str
+    (blk-send
+      (doc-deep-find (crdt-tree-materialize "d" orphan-merge) "c")
+      "text"))
+  "kept")
+(content-test
+  "orphan render at root"
+  (asHTML (crdt-tree-materialize "d" orphan-merge))
+  "<h2>Sub</h2><p>kept</p>")

lib/content/tests/crdt.sx

@@ -0,0 +1,315 @@
+;; Phase 3 — collaborative merge (CvRDT). The merge is a join: commutative,
+;; associative, idempotent. Tests apply ops in any order, twice, and merge
+;; replicas both ways — all must converge to identical state.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-render!)
+
+(define same? (fn (a b) (= (get a :elements) (get b :elements))))
+
+;; ── position order (Logoot) ──
+(content-test
+  "pos lt"
+  (crdt-pos-compare
+    (crdt-pos 1 0)
+    (crdt-pos 2 0))
+  -1)
+(content-test
+  "pos gt"
+  (crdt-pos-compare
+    (crdt-pos 2 0)
+    (crdt-pos 1 0))
+  1)
+(content-test
+  "pos eq"
+  (crdt-pos-compare
+    (crdt-pos 1 0)
+    (crdt-pos 1 0))
+  0)
+(content-test
+  "pos actor tiebreak"
+  (crdt-pos-compare
+    (crdt-pos 1 1)
+    (crdt-pos 1 2))
+  -1)
+(content-test
+  "between > left"
+  (<
+    (crdt-pos-compare
+      (crdt-pos 1 0)
+      (crdt-pos-between
+        (crdt-pos 1 0)
+        (crdt-pos 2 0)
+        9))
+    0)
+  true)
+(content-test
+  "between < right"
+  (<
+    (crdt-pos-compare
+      (crdt-pos-between
+        (crdt-pos 1 0)
+        (crdt-pos 2 0)
+        9)
+      (crdt-pos 2 0))
+    0)
+  true)
+(content-test
+  "between start < right"
+  (<
+    (crdt-pos-compare
+      (crdt-pos-between nil (crdt-pos 5 0) 9)
+      (crdt-pos 5 0))
+    0)
+  true)
+(content-test
+  "between end > left"
+  (<
+    (crdt-pos-compare
+      (crdt-pos 5 0)
+      (crdt-pos-between (crdt-pos 5 0) nil 9))
+    0)
+  true)
+
+;; ── build + materialise ──
+(define
+  base
+  (crdt-insert
+    (crdt-insert
+      (crdt-empty)
+      "h"
+      "heading"
+      (crdt-pos 1 0)
+      (list (list "level" 1) (list "text" "Title"))
+      1
+      0)
+    "p"
+    "text"
+    (crdt-pos 2 0)
+    (list (list "text" "Body"))
+    1
+    0))
+
+(content-test "order" (crdt-order base) (list "h" "p"))
+(content-test
+  "materialize ids"
+  (doc-ids (crdt-materialize "d" base))
+  (list "h" "p"))
+(content-test
+  "materialize render"
+  (asHTML (crdt-materialize "d" base))
+  "<h1>Title</h1><p>Body</p>")
+
+;; ── commutativity: ops in any order converge ──
+(define
+  opA
+  (crdt-op-insert
+    "x"
+    "text"
+    (crdt-pos 3 0)
+    (list (list "text" "X"))
+    2
+    1))
+(define opB (crdt-op-update "p" "text" "Edited" 5 1))
+(define opC (crdt-op-delete "h"))
+(define s-abc (crdt-apply-all base (list opA opB opC)))
+(define s-cba (crdt-apply-all base (list opC opB opA)))
+(define s-bca (crdt-apply-all base (list opB opC opA)))
+(content-test "commutative abc=cba" (same? s-abc s-cba) true)
+(content-test "commutative abc=bca" (same? s-abc s-bca) true)
+(content-test "commutative result order" (crdt-order s-abc) (list "p" "x"))
+
+;; ── idempotence: applying ops twice changes nothing ──
+(content-test
+  "idempotent ops"
+  (same? s-abc (crdt-apply-all s-abc (list opA opB opC)))
+  true)
+
+;; ── update-before-insert is not lost ──
+(define
+  ub
+  (crdt-apply-all
+    (crdt-empty)
+    (list
+      (crdt-op-update "z" "text" "late" 3 1)
+      (crdt-op-insert
+        "z"
+        "text"
+        (crdt-pos 1 0)
+        (list (list "text" "orig"))
+        1
+        1))))
+(content-test
+  "update before insert kept"
+  (str (blk-send (doc-find (crdt-materialize "d" ub) "z") "text"))
+  "late")
+
+;; ── delete-before-insert: remove-wins ──
+(define
+  db
+  (crdt-apply-all
+    (crdt-empty)
+    (list
+      (crdt-op-delete "k")
+      (crdt-op-insert
+        "k"
+        "text"
+        (crdt-pos 1 0)
+        (list (list "text" "x"))
+        1
+        1))))
+(content-test "delete before insert removes" (crdt-order db) (list))
+
+;; ── concurrent inserts converge + deterministic order ──
+(define
+  rA
+  (crdt-insert
+    base
+    "a1"
+    "text"
+    (crdt-pos 5 1)
+    (list (list "text" "A"))
+    2
+    1))
+(define
+  rB
+  (crdt-insert
+    base
+    "b1"
+    "text"
+    (crdt-pos 5 2)
+    (list (list "text" "B"))
+    2
+    2))
+(content-test
+  "merge commutes"
+  (same? (crdt-merge rA rB) (crdt-merge rB rA))
+  true)
+(content-test
+  "merge order deterministic AB"
+  (crdt-order (crdt-merge rA rB))
+  (list "h" "p" "a1" "b1"))
+(content-test
+  "merge order deterministic BA"
+  (crdt-order (crdt-merge rB rA))
+  (list "h" "p" "a1" "b1"))
+
+;; ── merge idempotence ──
+(define mAB (crdt-merge rA rB))
+(content-test "merge idempotent self" (same? (crdt-merge mAB mAB) mAB) true)
+(content-test
+  "merge idempotent remerge"
+  (same? (crdt-merge mAB rA) mAB)
+  true)
+
+;; ── concurrent same-field update: LWW by (ts, actor) ──
+(define u1 (crdt-update base "p" "text" "v-ts5" 5 1))
+(define u2 (crdt-update base "p" "text" "v-ts7" 7 2))
+(content-test
+  "LWW higher ts wins"
+  (str
+    (blk-send
+      (doc-find (crdt-materialize "d" (crdt-merge u1 u2)) "p")
+      "text"))
+  "v-ts7")
+(content-test
+  "LWW commutes"
+  (same? (crdt-merge u1 u2) (crdt-merge u2 u1))
+  true)
+(define t1 (crdt-update base "p" "text" "actor1" 9 1))
+(define t2 (crdt-update base "p" "text" "actor2" 9 2))
+(content-test
+  "LWW tie -> actor wins"
+  (str
+    (blk-send
+      (doc-find (crdt-materialize "d" (crdt-merge t1 t2)) "p")
+      "text"))
+  "actor2")
+
+;; ── concurrent disjoint-field updates both survive ──
+(define f1 (crdt-update base "h" "text" "NewTitle" 5 1))
+(define f2 (crdt-update base "h" "level" 3 5 2))
+(define fm (crdt-merge f1 f2))
+(content-test
+  "disjoint field text"
+  (str (blk-send (doc-find (crdt-materialize "d" fm) "h") "text"))
+  "NewTitle")
+(content-test
+  "disjoint field level"
+  (blk-send (doc-find (crdt-materialize "d" fm) "h") "level")
+  3)
+(content-test "disjoint commutes" (same? fm (crdt-merge f2 f1)) true)
+
+;; ── associativity ──
+(define c1 (crdt-update base "p" "text" "c1" 4 1))
+(define
+  c2
+  (crdt-insert
+    base
+    "n2"
+    "text"
+    (crdt-pos 6 0)
+    (list (list "text" "N"))
+    2
+    2))
+(define c3 (crdt-delete base "h"))
+(content-test
+  "associative"
+  (same?
+    (crdt-merge (crdt-merge c1 c2) c3)
+    (crdt-merge c1 (crdt-merge c2 c3)))
+  true)
+(content-test
+  "merge-all = fold"
+  (same?
+    (crdt-merge-all (list c1 c2 c3))
+    (crdt-merge c1 (crdt-merge c2 c3)))
+  true)
+
+;; ── full convergence: two replicas, divergent edits, merge both ways ──
+(define
+  repl-1
+  (crdt-apply-all
+    base
+    (list
+      (crdt-op-update "p" "text" "from-1" 5 1)
+      (crdt-op-insert
+        "img"
+        "image"
+        (crdt-pos-between
+          (crdt-pos 1 0)
+          (crdt-pos 2 0)
+          1)
+        (list (list "src" "/a.png") (list "alt" "a"))
+        6
+        1))))
+(define
+  repl-2
+  (crdt-apply-all
+    base
+    (list
+      (crdt-op-delete "h")
+      (crdt-op-update "p" "text" "from-2" 7 2))))
+(content-test
+  "two-replica converges"
+  (same? (crdt-merge repl-1 repl-2) (crdt-merge repl-2 repl-1))
+  true)
+(content-test
+  "two-replica result order"
+  (crdt-order (crdt-merge repl-1 repl-2))
+  (list "img" "p"))
+(content-test
+  "two-replica LWW field"
+  (str
+    (blk-send
+      (doc-find (crdt-materialize "d" (crdt-merge repl-1 repl-2)) "p")
+      "text"))
+  "from-2")
+(content-test
+  "two-replica idempotent"
+  (same?
+    (crdt-merge (crdt-merge repl-1 repl-2) repl-1)
+    (crdt-merge repl-1 repl-2))
+  true)

lib/content/tests/data.sx

@@ -0,0 +1,116 @@
+;; Extension — portable data serialization (to-data / from-data round-trip).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-text!)
+(content-bootstrap-markdown!)
+(content-bootstrap-section!)
+(content-bootstrap-table!)
+(content-bootstrap-callout!)
+(content-bootstrap-media!)
+
+;; ── block->data shape ──
+(define h (mk-heading "h" 2 "Hi"))
+(content-test "block->data id" (get (block->data h) :id) "h")
+(content-test "block->data type" (get (block->data h) :type) "heading")
+(content-test "block->data fields" (get (block->data h) :fields) {:text "Hi" :level 2})
+
+;; ── round-trip a mixed document with metadata ──
+(define
+  d
+  (doc-with-meta
+    (doc-append
+      (doc-append
+        (doc-append
+          (doc-append (doc-empty "post") (mk-heading "h" 1 "Title"))
+          (mk-text "p" "Body"))
+        (mk-image "img" "/c.png" "cat"))
+      (mk-list "l" true (list "a" "b")))
+    {:slug "s" :title "T" :tags (list "x" "y")}))
+
+(define rt (content/from-data (content/to-data d)))
+(content-test "rt id" (doc-id rt) "post")
+(content-test "rt title" (doc-title rt) "T")
+(content-test "rt slug" (doc-slug rt) "s")
+(content-test "rt tags" (doc-tags rt) (list "x" "y"))
+(content-test "rt ids" (doc-ids rt) (list "h" "p" "img" "l"))
+(content-test "rt render" (asHTML rt) (asHTML d))
+(content-test
+  "rt heading level"
+  (blk-send (doc-find rt "h") "level")
+  1)
+(content-test
+  "rt list items"
+  (blk-send (doc-find rt "l") "items")
+  (list "a" "b"))
+
+;; ── nested sections round-trip ──
+(define
+  ds
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "s"
+      (list
+        (mk-heading "nh" 2 "N")
+        (mk-section "i" (list (mk-text "x" "deep")))))))
+(define rts (content/from-data (content/to-data ds)))
+(content-test "rt nested render" (asHTML rts) (asHTML ds))
+(content-test "rt nested tree-ids" (doc-tree-ids rts) (doc-tree-ids ds))
+(content-test
+  "rt nested deep-find"
+  (str (blk-send (doc-deep-find rts "x") "text"))
+  "deep")
+
+;; ── table round-trip ──
+(define
+  dtb
+  (doc-append
+    (doc-empty "d")
+    (mk-table "t" (list "A" "B") (list (list "1" "2")))))
+(define rtt (content/from-data (content/to-data dtb)))
+(content-test "rt table render" (asHTML rtt) (asHTML dtb))
+(content-test
+  "rt table headers"
+  (table-headers (doc-find rtt "t"))
+  (list "A" "B"))
+
+;; ── callout + media round-trip (regression: ct-class-for-type must know them) ──
+(define
+  dcm
+  (doc-append
+    (doc-append (doc-empty "d") (mk-callout "co" "warning" "careful"))
+    (mk-video "vid" "/clip.mp4")))
+(define rtcm (content/from-data (content/to-data dcm)))
+(content-test "rt callout+media render" (asHTML rtcm) (asHTML dcm))
+(content-test
+  "rt callout kind"
+  (str (blk-send (doc-find rtcm "co") "kind"))
+  "warning")
+(content-test
+  "rt media kind"
+  (str (blk-send (doc-find rtcm "vid") "kind"))
+  "video")
+(content-test
+  "rt callout+media types"
+  (doc-types rtcm)
+  (list "callout" "media"))
+
+;; ── data is plain (no st-instance markers at top level) ──
+(define dat (content/to-data d))
+(content-test "data id field" (get dat :id) "post")
+(content-test "data block count" (len (get dat :blocks)) 4)
+(content-test
+  "data first block type"
+  (get (first (get dat :blocks)) :type)
+  "heading")
+
+;; ── empty doc round-trip ──
+(content-test
+  "rt empty ids"
+  (doc-ids (content/from-data (content/to-data (doc-empty "e"))))
+  (list))
+(content-test
+  "rt no-meta title nil"
+  (doc-title (content/from-data (content/to-data (doc-empty "e"))))
+  nil)

lib/content/tests/doc.sx

@@ -0,0 +1,132 @@
+;; Phase 1 — ordered block document: apply edit ops, structural moves.
+;; Every op returns a NEW document; the input is never mutated.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+
+(define h (mk-heading "h" 1 "Title"))
+(define p1 (mk-text "p1" "First"))
+(define p2 (mk-text "p2" "Second"))
+(define img (mk-image "img" "/c.png" "cat"))
+
+;; ── empty + construction ──
+(define d0 (doc-empty "doc1"))
+(content-test "empty id" (doc-id d0) "doc1")
+(content-test "empty type" (doc-type d0) "document")
+(content-test "empty count" (doc-count d0) 0)
+(content-test "doc? on doc" (doc? d0) true)
+(content-test "doc? on block" (doc? h) false)
+
+;; ── append + order ──
+(define d1 (doc-append (doc-append (doc-append d0 h) p1) p2))
+(content-test "append count" (doc-count d1) 3)
+(content-test "append order" (doc-ids d1) (list "h" "p1" "p2"))
+(content-test "append types" (doc-types d1) (list "heading" "text" "text"))
+(content-test "block-at 0" (blk-id (doc-block-at d1 0)) "h")
+
+;; ── append is immutable ──
+(content-test "append leaves original" (doc-count d0) 0)
+
+;; ── find / index / has ──
+(content-test "find p1" (blk-id (doc-find d1 "p1")) "p1")
+(content-test "find missing" (doc-find d1 "nope") nil)
+(content-test "index-of p2" (doc-index-of d1 "p2") 2)
+(content-test "index-of missing" (doc-index-of d1 "nope") -1)
+(content-test "has? yes" (doc-has? d1 "h") true)
+(content-test "has? no" (doc-has? d1 "x") false)
+
+;; ── insert-after ──
+(define d2 (doc-insert-after d1 img "h"))
+(content-test "insert-after order" (doc-ids d2) (list "h" "img" "p1" "p2"))
+(content-test
+  "insert-after prepend"
+  (doc-ids (doc-insert-after d1 img nil))
+  (list "img" "h" "p1" "p2"))
+(content-test
+  "insert-after missing appends"
+  (doc-ids (doc-insert-after d1 img "zzz"))
+  (list "h" "p1" "p2" "img"))
+(content-test "insert-after immutable" (doc-ids d1) (list "h" "p1" "p2"))
+
+;; ── insert-at ──
+(content-test
+  "insert-at 0"
+  (doc-ids (doc-insert-at d1 img 0))
+  (list "img" "h" "p1" "p2"))
+(content-test
+  "insert-at 1"
+  (doc-ids (doc-insert-at d1 img 1))
+  (list "h" "img" "p1" "p2"))
+
+;; ── update (copy-on-write block) ──
+(define d3 (doc-update d1 "p1" "text" "Edited"))
+(content-test
+  "update value"
+  (str (blk-send (doc-find d3 "p1") "text"))
+  "Edited")
+(content-test "update keeps order" (doc-ids d3) (list "h" "p1" "p2"))
+(content-test
+  "update immutable"
+  (str (blk-send (doc-find d1 "p1") "text"))
+  "First")
+
+;; ── delete ──
+(define d4 (doc-delete d1 "p1"))
+(content-test "delete order" (doc-ids d4) (list "h" "p2"))
+(content-test "delete count" (doc-count d4) 2)
+(content-test "delete immutable" (doc-count d1) 3)
+(content-test
+  "delete missing no-op"
+  (doc-ids (doc-delete d1 "x"))
+  (list "h" "p1" "p2"))
+
+;; ── move ──
+(content-test
+  "move p2 to front"
+  (doc-ids (doc-move d1 "p2" 0))
+  (list "p2" "h" "p1"))
+(content-test
+  "move h to end"
+  (doc-ids (doc-move d1 "h" 2))
+  (list "p1" "p2" "h"))
+(content-test
+  "move missing no-op"
+  (doc-ids (doc-move d1 "x" 0))
+  (list "h" "p1" "p2"))
+(content-test "move immutable" (doc-ids d1) (list "h" "p1" "p2"))
+
+;; ── op constructors + interpreter ──
+(content-test
+  "op-insert apply"
+  (doc-ids (doc-apply d1 (op-insert img "h")))
+  (list "h" "img" "p1" "p2"))
+(content-test
+  "op-delete apply"
+  (doc-ids (doc-apply d1 (op-delete "h")))
+  (list "p1" "p2"))
+(content-test
+  "op-move apply"
+  (doc-ids (doc-apply d1 (op-move "p2" 0)))
+  (list "p2" "h" "p1"))
+(content-test
+  "op-update apply"
+  (str
+    (blk-send
+      (doc-find (doc-apply d1 (op-update "p1" "text" "X")) "p1")
+      "text"))
+  "X")
+
+;; ── apply-all: a stream of ops ──
+(define
+  ops
+  (list (op-insert img "h") (op-delete "p1") (op-move "p2" 0)))
+(content-test
+  "apply-all"
+  (doc-ids (doc-apply-all d1 ops))
+  (list "p2" "h" "img"))
+(content-test "apply-all immutable" (doc-ids d1) (list "h" "p1" "p2"))
+(content-test
+  "apply-all empty"
+  (doc-ids (doc-apply-all d1 (list)))
+  (list "h" "p1" "p2"))

lib/content/tests/fed.sx

@@ -0,0 +1,148 @@
+;; Phase 4 — federated documents: trust-gated peer ops + concurrent-external-
+;; edit conflict resolution via the CRDT.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-render!)
+
+(define same? (fn (a b) (= (get a :elements) (get b :elements))))
+
+;; base shared document, then a local edit
+(define
+  base
+  (crdt-insert
+    (crdt-insert
+      (crdt-empty)
+      "h"
+      "heading"
+      (crdt-pos 1 0)
+      (list (list "level" 1) (list "text" "T"))
+      1
+      0)
+    "p"
+    "text"
+    (crdt-pos 2 0)
+    (list (list "text" "Body"))
+    1
+    0))
+(define local (crdt-update base "p" "text" "local" 5 1))
+
+;; ── provenance ──
+(content-test
+  "authored tags author"
+  (get (content/authored (crdt-op-delete "h") "ed") :author)
+  "ed")
+(content-test
+  "signed tags sig"
+  (get (content/signed (crdt-op-delete "h") "ed" "sig1") :sig)
+  "sig1")
+(content-test "trusted? yes" (content/trusted? (list "ed" "al") "ed") true)
+(content-test "trusted? no" (content/trusted? (list "ed") "mal") false)
+
+;; peer ops: ed is trusted, mal is not
+(define
+  peer-ops
+  (list
+    (content/authored
+      (crdt-op-update "p" "text" "peer-ed" 7 2)
+      "ed")
+    (content/authored
+      (crdt-op-insert
+        "x"
+        "text"
+        (crdt-pos 3 0)
+        (list (list "text" "X"))
+        8
+        2)
+      "ed")
+    (content/authored (crdt-op-delete "h") "mal")))
+
+(define res (content/merge-peer local (list "ed") peer-ops))
+
+;; ── trust gate: only ed's ops applied ──
+(content-test "accepted count" (len (content/accepted res)) 2)
+(content-test "rejected count" (len (content/rejected res)) 1)
+(content-test
+  "rejected is mal's"
+  (get (first (content/rejected res)) :author)
+  "mal")
+
+;; ── resulting document ──
+(define rdoc (crdt-materialize "d" (content/peer-state res)))
+(content-test "untrusted delete blocked: h survives" (doc-has? rdoc "h") true)
+(content-test "trusted insert applied: x present" (doc-has? rdoc "x") true)
+(content-test "result order" (doc-ids rdoc) (list "h" "p" "x"))
+(content-test
+  "trusted edit wins (ts7 > ts5)"
+  (str (blk-send (doc-find rdoc "p") "text"))
+  "peer-ed")
+
+;; ── order-independence of accepted peer ops ──
+(define res-rev (content/merge-peer local (list "ed") (reverse peer-ops)))
+(content-test
+  "peer merge order-independent"
+  (same? (content/peer-state res) (content/peer-state res-rev))
+  true)
+
+;; ── trust = nobody → nothing applied, state unchanged ──
+(define res0 (content/merge-peer local (list) peer-ops))
+(content-test
+  "no trust accepts none"
+  (len (content/accepted res0))
+  0)
+(content-test
+  "no trust rejects all"
+  (len (content/rejected res0))
+  3)
+(content-test
+  "no trust state unchanged"
+  (same? (content/peer-state res0) local)
+  true)
+
+;; ── pluggable predicate gate (acl-on-sx hook) ──
+(define
+  res-pred
+  (content/merge-peer-with
+    local
+    (fn (op) (= (get op :author) "ed"))
+    peer-ops))
+(content-test
+  "predicate gate == list gate"
+  (same? (content/peer-state res-pred) (content/peer-state res))
+  true)
+
+;; ── conflict on concurrent external edit: local vs external, same field ──
+;; external (peer) state edits p concurrently with a later ts; CRDT reconciles.
+(define
+  external
+  (crdt-update base "p" "text" "external" 9 2))
+(content-test
+  "conflict LWW deterministic"
+  (str
+    (blk-send
+      (doc-find (crdt-materialize "d" (crdt-merge local external)) "p")
+      "text"))
+  "external")
+(content-test
+  "conflict merge commutes"
+  (same? (crdt-merge local external) (crdt-merge external local))
+  true)
+(content-test
+  "conflict merge idempotent"
+  (same?
+    (crdt-merge (crdt-merge local external) external)
+    (crdt-merge local external))
+  true)
+
+;; concurrent external edit with LOWER ts loses to local
+(define
+  external-old
+  (crdt-update base "p" "text" "stale" 3 2))
+(content-test
+  "older external loses to local"
+  (str
+    (blk-send
+      (doc-find (crdt-materialize "d" (crdt-merge local external-old)) "p")
+      "text"))
+  "local")

lib/content/tests/find-replace.sx

@@ -0,0 +1,148 @@
+;; Extension — global find/replace across every text-bearing field.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+(content-bootstrap-callout!)
+(content-bootstrap-table!)
+
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append (doc-empty "d") (mk-heading "h" 1 "Foo title"))
+      (mk-text "p" "the Foo is here"))
+    (mk-section
+      "s"
+      (list (mk-text "n" "nested Foo") (mk-image "img" "/foo.png" "Foo alt")))))
+
+(define r (content/find-replace d "Foo" "Bar"))
+
+;; ── replaces in heading + text ──
+(content-test
+  "replace heading"
+  (str (blk-send (doc-deep-find r "h") "text"))
+  "Bar title")
+(content-test
+  "replace text"
+  (str (blk-send (doc-deep-find r "p") "text"))
+  "the Bar is here")
+(content-test
+  "replace nested text"
+  (str (blk-send (doc-deep-find r "n") "text"))
+  "nested Bar")
+
+;; ── image alt IS a text field (asText ^ alt), so it is rewritten ──
+(content-test
+  "image alt replaced"
+  (str (blk-send (doc-deep-find r "img") "alt"))
+  "Bar alt")
+;; ── but src is a URL, not prose, so it stays put ──
+(content-test
+  "image src untouched"
+  (str (blk-send (doc-deep-find r "img") "src"))
+  "/foo.png")
+
+;; ── immutable ──
+(content-test
+  "original unchanged"
+  (str (blk-send (doc-deep-find d "p") "text"))
+  "the Foo is here")
+
+;; ── multiple occurrences in one block ──
+(content-test
+  "all occurrences"
+  (str
+    (blk-send
+      (doc-find
+        (content/find-replace
+          (doc-append (doc-empty "d") (mk-text "p" "a a a"))
+          "a"
+          "b")
+        "p")
+      "text"))
+  "b b b")
+
+;; ── code + quote text replaced ──
+(define
+  d2
+  (doc-append
+    (doc-append (doc-empty "d") (mk-code "c" "sx" "(old)"))
+    (mk-quote "q" "src" "old saying")))
+(define r2 (content/find-replace d2 "old" "new"))
+(content-test
+  "replace code"
+  (str (blk-send (doc-find r2 "c") "text"))
+  "(new)")
+(content-test
+  "replace quote"
+  (str (blk-send (doc-find r2 "q") "text"))
+  "new saying")
+
+;; ── callout text is covered (consistency with asText/stats/summary) ──
+(content-test
+  "replace callout text"
+  (str
+    (blk-send
+      (doc-find
+        (content/find-replace
+          (doc-append (doc-empty "d") (mk-callout "co" "note" "Foo here"))
+          "Foo"
+          "Bar")
+        "co")
+      "text"))
+  "Bar here")
+(content-test
+  "callout kind untouched by text replace"
+  (str
+    (blk-send
+      (doc-find
+        (content/find-replace
+          (doc-append (doc-empty "d") (mk-callout "co" "note" "x"))
+          "note"
+          "X")
+        "co")
+      "kind"))
+  "note")
+
+;; ── list items are rewritten (asText folds items) ──
+(define
+  rl
+  (content/find-replace
+    (doc-append
+      (doc-empty "d")
+      (mk-list "l" false (list "Foo one" "two Foo")))
+    "Foo"
+    "Bar"))
+(content-test
+  "replace first list item"
+  (str (first (blk-send (doc-find rl "l") "items")))
+  "Bar one")
+(content-test
+  "replace second list item"
+  (str (first (rest (blk-send (doc-find rl "l") "items"))))
+  "two Bar")
+
+;; ── table headers + cells are rewritten (asText folds rows) ──
+(define
+  rt
+  (content/find-replace
+    (doc-append
+      (doc-empty "d")
+      (mk-table "t" (list "Foo head") (list (list "a Foo" "b"))))
+    "Foo"
+    "Bar"))
+(content-test
+  "replace table header"
+  (str (first (table-headers (doc-find rt "t"))))
+  "Bar head")
+(content-test
+  "replace table cell"
+  (str (first (first (table-rows (doc-find rt "t")))))
+  "a Bar")
+
+;; ── no match → unchanged render ──
+(content-test
+  "no match"
+  (asHTML (content/find-replace d "zzz" "qqq"))
+  (asHTML d))

lib/content/tests/flatten.sx

@@ -0,0 +1,72 @@
+;; Extension — document flatten (un-nest sections).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "Top"))
+    (mk-section "s" (list (mk-text "a" "A") (mk-text "b" "B")))))
+
+;; ── one level un-nested ──
+(define f (content/flatten d))
+(content-test "flatten ids" (doc-ids f) (list "h" "a" "b"))
+(content-test
+  "flatten no sections"
+  (content/types f)
+  (list "heading" "text" "text"))
+(content-test "flatten immutable" (doc-ids d) (list "h" "s"))
+(content-test "flatten render" (asHTML f) "<h1>Top</h1><p>A</p><p>B</p>")
+
+;; ── deep nesting fully flattened ──
+(define
+  deep
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "o"
+      (list
+        (mk-text "x" "X")
+        (mk-section
+          "i"
+          (list (mk-text "y" "Y") (mk-heading "z" 2 "Z")))))))
+(content-test
+  "deep flatten ids"
+  (doc-ids (content/flatten deep))
+  (list "x" "y" "z"))
+
+;; ── inverse of wrap-section ──
+(define
+  plain
+  (doc-append
+    (doc-append (doc-empty "p") (mk-text "a" "A"))
+    (mk-text "b" "B")))
+(content-test
+  "flatten . wrap == identity ids"
+  (doc-ids (content/flatten (content/wrap-section plain "sec")))
+  (doc-ids plain))
+(content-test
+  "flatten . wrap == identity render"
+  (asHTML (content/flatten (content/wrap-section plain "sec")))
+  (asHTML plain))
+
+;; ── already-flat doc unchanged ──
+(content-test
+  "flat unchanged"
+  (asHTML (content/flatten plain))
+  (asHTML plain))
+
+;; ── empty section disappears ──
+(content-test
+  "empty section flattens away"
+  (doc-ids
+    (content/flatten (doc-append (doc-empty "d") (mk-section "s" (list)))))
+  (list))
+
+;; ── empty doc ──
+(content-test
+  "flatten empty"
+  (doc-ids (content/flatten (doc-empty "e")))
+  (list))

lib/content/tests/index.sx

@@ -0,0 +1,61 @@
+;; Extension — multi-document index + tag filtering.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-text!)
+
+(define
+  a
+  (doc-with-meta
+    (doc-append (doc-empty "a") (mk-text "p" "first post"))
+    {:title "A" :tags (list "sx" "news")}))
+(define
+  b
+  (doc-with-meta
+    (doc-append (doc-empty "b") (mk-text "p" "second post"))
+    {:title "B" :tags (list "news")}))
+(define
+  c
+  (doc-with-meta
+    (doc-append (doc-empty "c") (mk-text "p" "third"))
+    {:title "C" :tags (list "sx")}))
+(define docs (list a b c))
+
+;; ── index = list of summaries ──
+(define idx (content/index docs))
+(content-test "index count" (len idx) 3)
+(content-test
+  "index titles"
+  (map (fn (s) (get s :title)) idx)
+  (list "A" "B" "C"))
+(content-test
+  "index ids"
+  (map (fn (s) (get s :id)) idx)
+  (list "a" "b" "c"))
+(content-test "index excerpt" (get (first idx) :excerpt) "first post")
+
+;; ── has-tag? ──
+(content-test "has-tag yes" (content/has-tag? a "news") true)
+(content-test "has-tag no" (content/has-tag? c "news") false)
+
+;; ── index-by-tag (category page) ──
+(content-test
+  "by-tag news"
+  (map (fn (s) (get s :id)) (content/index-by-tag docs "news"))
+  (list "a" "b"))
+(content-test
+  "by-tag sx"
+  (map (fn (s) (get s :id)) (content/index-by-tag docs "sx"))
+  (list "a" "c"))
+(content-test "by-tag none" (content/index-by-tag docs "missing") (list))
+
+;; ── all-tags (tag cloud, deduped, document order) ──
+(content-test "all-tags" (content/all-tags docs) (list "sx" "news"))
+(content-test "all-tags empty" (content/all-tags (list)) (list))
+(content-test
+  "all-tags untagged"
+  (content/all-tags (list (doc-empty "x")))
+  (list))
+
+;; ── empty index ──
+(content-test "empty index" (content/index (list)) (list))

lib/content/tests/markdown.sx

@@ -0,0 +1,79 @@
+;; Extension — Markdown render mode. asMarkdown is a polymorphic message send;
+;; the boundary supplies the newline.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+
+(define nl (str "\n"))
+
+;; ── per-block ──
+(content-test
+  "heading h3"
+  (asMarkdown (mk-heading "h" 3 "Title"))
+  "### Title")
+(content-test
+  "heading h1"
+  (asMarkdown (mk-heading "h" 1 "T"))
+  "# T")
+(content-test "text md" (asMarkdown (mk-text "p" "body")) "body")
+(content-test
+  "quote md"
+  (asMarkdown (mk-quote "q" "Ada" "to err"))
+  "> to err")
+(content-test
+  "image md"
+  (asMarkdown (mk-image "i" "/c.png" "cat"))
+  "![cat](/c.png)")
+(content-test
+  "embed md"
+  (asMarkdown (mk-embed "e" "https://v/1" "vimeo"))
+  "[embed](https://v/1)")
+(content-test "divider md" (asMarkdown (mk-divider "d")) "---")
+(content-test
+  "code md"
+  (asMarkdown (mk-code "c" "sx" "(+ 1 2)"))
+  (str "```sx" nl "(+ 1 2)" nl "```"))
+(content-test
+  "ul md"
+  (asMarkdown (mk-list "u" false (list "a" "b" "c")))
+  (str "- a" nl "- b" nl "- c"))
+(content-test
+  "ol md"
+  (asMarkdown (mk-list "o" true (list "x" "y")))
+  (str "1. x" nl "1. y"))
+(content-test "empty list md" (asMarkdown (mk-list "e" false (list))) "")
+
+;; ── document joins blocks with a blank line ──
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append (doc-empty "doc") (mk-heading "h" 2 "Title"))
+      (mk-text "p" "Hello"))
+    (mk-divider "d")))
+(content-test
+  "doc md"
+  (asMarkdown d)
+  (str "## Title" nl nl "Hello" nl nl "---"))
+(content-test "empty doc md" (asMarkdown (doc-empty "e")) "")
+
+;; ── via facade ──
+(content-test "render md" (content/render d "md") (asMarkdown d))
+(content-test "render markdown" (content/render d "markdown") (asMarkdown d))
+(content-test "render md keyword" (content/render d :md) (asMarkdown d))
+(content-test "content/markdown alias" (content/markdown d) (asMarkdown d))
+(content-test
+  "block-markdown alias"
+  (block-markdown (mk-heading "h" 2 "X"))
+  "## X")
+
+;; ── reflects edits / immutability ──
+(content-test
+  "md after update"
+  (asMarkdown (doc-update d "p" "text" "Edited"))
+  (str "## Title" nl nl "Edited" nl nl "---"))
+(content-test
+  "md original unchanged"
+  (asMarkdown d)
+  (str "## Title" nl nl "Hello" nl nl "---"))

lib/content/tests/md-doc.sx

@@ -0,0 +1,71 @@
+;; Extension — Markdown document export (frontmatter + body), round-trips with
+;; md/import including metadata.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-table!)
+
+(define nl (str "\n"))
+
+;; ── no metadata → plain markdown (no frontmatter) ──
+(define plain (doc-append (doc-empty "d") (mk-heading "h" 1 "Hi")))
+(content-test
+  "no-meta == asMarkdown"
+  (content/markdown-doc plain)
+  (asMarkdown plain))
+(content-test "no-meta no frontmatter" (content/markdown-doc plain) "# Hi")
+
+;; ── full metadata frontmatter ──
+(define
+  d
+  (doc-with-meta
+    (doc-append (doc-empty "post") (mk-heading "h" 1 "Hi"))
+    {:slug "my-post" :title "My Post" :tags (list "a" "b")}))
+(content-test
+  "frontmatter export"
+  (content/markdown-doc d)
+  (str
+    "---"
+    nl
+    "title: My Post"
+    nl
+    "slug: my-post"
+    nl
+    "tags: a, b"
+    nl
+    "---"
+    nl
+    nl
+    "# Hi"))
+
+;; ── title only ──
+(content-test
+  "title-only frontmatter"
+  (content/markdown-doc
+    (doc-with-title (doc-append (doc-empty "p") (mk-text "x" "body")) "T"))
+  (str "---" nl "title: T" nl "---" nl nl "body"))
+
+;; ── round-trip: import . export keeps metadata + blocks ──
+(define rt (md/import (content/markdown-doc d) "post"))
+(content-test "round-trip title" (doc-title rt) "My Post")
+(content-test "round-trip slug" (doc-slug rt) "my-post")
+(content-test "round-trip tags" (doc-tags rt) (list "a" "b"))
+(content-test "round-trip body" (doc-types rt) (list "heading"))
+(content-test
+  "round-trip body text"
+  (str (blk-send (doc-find rt "b0") "text"))
+  "Hi")
+
+;; ── round-trip a richer doc ──
+(define
+  d2
+  (doc-with-meta
+    (doc-append
+      (doc-append (doc-empty "p") (mk-heading "h" 2 "Title"))
+      (mk-text "p" "para text"))
+    {:title "Big" :tags (list "x")}))
+(define rt2 (md/import (content/markdown-doc d2) "p"))
+(content-test "rt2 title" (doc-title rt2) "Big")
+(content-test "rt2 tags" (doc-tags rt2) (list "x"))
+(content-test "rt2 types" (doc-types rt2) (list "heading" "text"))

lib/content/tests/md-import.sx

@@ -0,0 +1,206 @@
+;; Extension — Markdown import adapter (markdown text -> blocks), inverse of
+;; asMarkdown. Round-trips canonical Markdown; parses frontmatter + tables.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-table!)
+
+(define nl (str "\n"))
+
+;; ── headings ──
+(define dh (md/import "# Title" "d"))
+(content-test "heading import type" (doc-types dh) (list "heading"))
+(content-test
+  "heading level"
+  (blk-send (doc-find dh "b0") "level")
+  1)
+(content-test
+  "heading text"
+  (str (blk-send (doc-find dh "b0") "text"))
+  "Title")
+(content-test
+  "h3 import"
+  (blk-send (doc-find (md/import "### Deep" "d") "b0") "level")
+  3)
+
+;; ── paragraph (consecutive lines join with space) ──
+(content-test
+  "paragraph join"
+  (str
+    (blk-send
+      (doc-find (md/import (str "hello" nl "world") "d") "b0")
+      "text"))
+  "hello world")
+
+;; ── blockquote, divider ──
+(content-test
+  "blockquote"
+  (str (blk-send (doc-find (md/import "> quoted" "d") "b0") "text"))
+  "quoted")
+(content-test "divider" (doc-types (md/import "---" "d")) (list "divider"))
+
+;; ── unordered + ordered lists ──
+(define dul (md/import (str "- a" nl "- b" nl "- c") "d"))
+(content-test "ul type" (doc-types dul) (list "list"))
+(content-test
+  "ul not ordered"
+  (blk-send (doc-find dul "b0") "ordered")
+  false)
+(content-test
+  "ul items"
+  (blk-send (doc-find dul "b0") "items")
+  (list "a" "b" "c"))
+(define dol (md/import (str "1. x" nl "2. y") "d"))
+(content-test "ol ordered" (blk-send (doc-find dol "b0") "ordered") true)
+(content-test
+  "ol items"
+  (blk-send (doc-find dol "b0") "items")
+  (list "x" "y"))
+
+;; ── fenced code ──
+(define dc (md/import (str "```sx" nl "(+ 1 2)" nl "(* 3 4)" nl "```") "d"))
+(content-test "code type" (doc-types dc) (list "code"))
+(content-test
+  "code language"
+  (str (blk-send (doc-find dc "b0") "language"))
+  "sx")
+(content-test
+  "code body"
+  (str (blk-send (doc-find dc "b0") "text"))
+  (str "(+ 1 2)" nl "(* 3 4)"))
+
+;; ── multiple blocks separated by blank lines ──
+(define dm (md/import (str "# H" nl nl "para" nl nl "- a" nl "- b") "d"))
+(content-test "multi types" (doc-types dm) (list "heading" "text" "list"))
+(content-test "multi ids" (doc-ids dm) (list "b0" "b1" "b2"))
+
+;; ── empty / blank input ──
+(content-test "empty input" (doc-ids (md/import "" "d")) (list))
+(content-test
+  "blank lines only"
+  (doc-ids (md/import (str nl nl) "d"))
+  (list))
+
+;; ── pipe tables ──
+(define
+  dt
+  (md/import
+    (str
+      "| Name | Age |"
+      nl
+      "| --- | --- |"
+      nl
+      "| Ada | 36 |"
+      nl
+      "| Al | 40 |")
+    "d"))
+(content-test "table import type" (doc-types dt) (list "table"))
+(content-test
+  "table headers"
+  (table-headers (doc-find dt "b0"))
+  (list "Name" "Age"))
+(content-test
+  "table rows"
+  (table-rows (doc-find dt "b0"))
+  (list (list "Ada" "36") (list "Al" "40")))
+(content-test
+  "table round-trip"
+  (asMarkdown
+    (md/import (str "| A | B |" nl "| --- | --- |" nl "| 1 | 2 |") "d"))
+  (str "| A | B |" nl "| --- | --- |" nl "| 1 | 2 |"))
+(define
+  dmix
+  (md/import
+    (str
+      "# Title"
+      nl
+      nl
+      "| H1 | H2 |"
+      nl
+      "| --- | --- |"
+      nl
+      "| a | b |"
+      nl
+      nl
+      "para")
+    "d"))
+(content-test
+  "table mixed types"
+  (doc-types dmix)
+  (list "heading" "table" "text"))
+
+;; ── frontmatter ──
+(define
+  dfm
+  (md/import
+    (str
+      "---"
+      nl
+      "title: My Post"
+      nl
+      "slug: my-post"
+      nl
+      "tags: a, b, c"
+      nl
+      "---"
+      nl
+      "# Hi"
+      nl
+      nl
+      "body")
+    "d"))
+(content-test "fm title" (doc-title dfm) "My Post")
+(content-test "fm slug" (doc-slug dfm) "my-post")
+(content-test "fm tags" (doc-tags dfm) (list "a" "b" "c"))
+(content-test "fm body types" (doc-types dfm) (list "heading" "text"))
+(content-test
+  "fm body content"
+  (str (blk-send (doc-find dfm "b0") "text"))
+  "Hi")
+(content-test "no fm title nil" (doc-title (md/import "# Hi" "d")) nil)
+(content-test
+  "hr not frontmatter"
+  (doc-types (md/import (str "text" nl nl "---") "d"))
+  (list "text" "divider"))
+(define dfmo (md/import (str "---" nl "title: T" nl "---") "d"))
+(content-test "fm only title" (doc-title dfmo) "T")
+(content-test "fm only empty body" (doc-ids dfmo) (list))
+
+;; ── round-trip: import . export == identity (canonical markdown) ──
+(define
+  src
+  (str
+    "# Title"
+    nl
+    nl
+    "hello world"
+    nl
+    nl
+    "> quoted"
+    nl
+    nl
+    "- a"
+    nl
+    "- b"
+    nl
+    nl
+    "---"))
+(content-test "round-trip markdown" (asMarkdown (md/import src "d")) src)
+(content-test
+  "round-trip code"
+  (asMarkdown (md/import (str "```js" nl "x = 1" nl "```") "d"))
+  (str "```js" nl "x = 1" nl "```"))
+
+;; ── adapter form ──
+(content-test
+  "adapter import"
+  (doc-types (content/import markdown-adapter "# Hi" "d"))
+  (list "heading"))
+(content-test
+  "adapter export round-trip"
+  (content/export markdown-adapter (content/import markdown-adapter src "d"))
+  src)
+
+;; ── imported doc validates ──
+(content-test "imported doc valid" (content/valid? (md/import src "d")) true)

lib/content/tests/media.sx

@@ -0,0 +1,59 @@
+;; Extension — video/audio media block.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-text!)
+(content-bootstrap-media!)
+
+(define v (mk-video "v" "/clip.mp4"))
+(define a (mk-audio "a" "/song.mp3"))
+
+;; ── identity ──
+(content-test "media is block" (block? v) true)
+(content-test "media? yes" (media? v) true)
+(content-test "video type" (blk-type v) "media")
+(content-test "video kind" (media-kind v) "video")
+(content-test "audio kind" (media-kind a) "audio")
+
+;; ── render ──
+(content-test
+  "video html"
+  (asHTML v)
+  "<video src=\"/clip.mp4\" controls></video>")
+(content-test
+  "audio html"
+  (asHTML a)
+  "<audio src=\"/song.mp3\" controls></audio>")
+(content-test "video sx" (asSx v) "(video :src \"/clip.mp4\")")
+(content-test "video text" (asText v) "")
+(content-test "video markdown" (asMarkdown v) "[video](/clip.mp4)")
+(content-test "audio markdown" (asMarkdown a) "[audio](/song.mp3)")
+
+;; ── html escapes src ──
+(content-test
+  "media html escapes"
+  (asHTML (mk-video "v" "/a.mp4?x=1&y=2"))
+  "<video src=\"/a.mp4?x=1&amp;y=2\" controls></video>")
+
+;; ── in a document ──
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "Watch"))
+    v))
+(content-test
+  "doc with media html"
+  (asHTML d)
+  "<h1>Watch</h1><video src=\"/clip.mp4\" controls></video>")
+
+;; ── validation ──
+(content-test
+  "valid media"
+  (content/valid? (doc-append (doc-empty "d") v))
+  true)
+(content-test
+  "bad media kind flagged"
+  (content/issue-kinds
+    (doc-append (doc-empty "d") (mk-media "m" "movie" "/x")))
+  (list "field"))

lib/content/tests/meta.sx

@@ -0,0 +1,79 @@
+;; Extension — document metadata (title/slug/tags) + Ghost title plumbing.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+
+(define d (doc-empty "post"))
+
+;; ── defaults ──
+(content-test "default title nil" (doc-title d) nil)
+(content-test "default slug nil" (doc-slug d) nil)
+(content-test "default tags empty" (doc-tags d) (list))
+
+;; ── copy-on-write setters ──
+(define d2 (doc-with-title d "Hello World"))
+(content-test "with-title" (doc-title d2) "Hello World")
+(content-test "with-title immutable" (doc-title d) nil)
+(content-test "with-title keeps id" (doc-id d2) "post")
+
+(define d3 (doc-with-slug (doc-with-title d "T") "my-slug"))
+(content-test "with-slug" (doc-slug d3) "my-slug")
+(content-test "title preserved with slug" (doc-title d3) "T")
+
+(define d4 (doc-with-tags d (list "a" "b")))
+(content-test "with-tags" (doc-tags d4) (list "a" "b"))
+(content-test "add-tag" (doc-tags (doc-add-tag d4 "c")) (list "a" "b" "c"))
+(content-test
+  "add-tag from empty"
+  (doc-tags (doc-add-tag d "x"))
+  (list "x"))
+
+;; ── batch + dict ──
+(define d5 (doc-with-meta d {:slug "s" :title "T" :tags (list "t1")}))
+(content-test "with-meta title" (doc-title d5) "T")
+(content-test "with-meta slug" (doc-slug d5) "s")
+(content-test "with-meta tags" (doc-tags d5) (list "t1"))
+(content-test
+  "with-meta partial leaves title"
+  (doc-title (doc-with-meta d {:slug "only"}))
+  nil)
+(content-test "doc-meta dict" (doc-meta d5) {:slug "s" :id "post" :title "T" :tags (list "t1")})
+
+;; ── constructor with metadata ──
+(define d6 (doc-new-meta "p2" (list (mk-text "x" "hi")) {:title "Post 2"}))
+(content-test "new-meta title" (doc-title d6) "Post 2")
+(content-test "new-meta blocks" (doc-ids d6) (list "x"))
+
+;; ── facade aliases ──
+(content-test "content/title" (content/title d5) "T")
+(content-test
+  "content/with-title"
+  (content/title (content/with-title d "Z"))
+  "Z")
+(content-test "content/meta" (content/meta d5) (doc-meta d5))
+
+;; ── metadata coexists with block ops ──
+(define
+  d7
+  (doc-append
+    (doc-with-title (doc-empty "x") "Titled")
+    (mk-text "p" "body")))
+(content-test "meta + blocks coexist" (doc-ids d7) (list "p"))
+(content-test "meta survives append" (doc-title d7) "Titled")
+(content-test
+  "meta survives edit"
+  (doc-title (doc-update d7 "p" "text" "changed"))
+  "Titled")
+
+;; ── Ghost adapter now carries title ──
+(define post {:sections (list {:id "h" :text "Hi" :kind "heading" :level 1}) :title "My Post"})
+(define gd (content/import ghost-adapter post "post"))
+(content-test "ghost import title" (doc-title gd) "My Post")
+(content-test
+  "ghost export title"
+  (get (content/export ghost-adapter gd) :title)
+  "My Post")
+(content-test
+  "ghost title round-trip"
+  (doc-title (content/round-trip ghost-adapter gd))
+  "My Post")

lib/content/tests/move.sx

@@ -0,0 +1,145 @@
+;; Extension — relative block reorder + tree reparent.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append (doc-empty "d") (mk-text "a" "A"))
+      (mk-text "b" "B"))
+    (mk-text "c" "C")))
+
+;; ── move-before ──
+(content-test
+  "move-before"
+  (doc-ids (content/move-before d "c" "a"))
+  (list "c" "a" "b"))
+(content-test
+  "move-before mid"
+  (doc-ids (content/move-before d "c" "b"))
+  (list "a" "c" "b"))
+(content-test "move-before immutable" (doc-ids d) (list "a" "b" "c"))
+
+;; ── move-after ──
+(content-test
+  "move-after"
+  (doc-ids (content/move-after d "a" "b"))
+  (list "b" "a" "c"))
+(content-test
+  "move-after last"
+  (doc-ids (content/move-after d "a" "c"))
+  (list "b" "c" "a"))
+
+;; ── move-to-front / back ──
+(content-test
+  "move-to-front"
+  (doc-ids (content/move-to-front d "c"))
+  (list "c" "a" "b"))
+(content-test
+  "move-to-back"
+  (doc-ids (content/move-to-back d "a"))
+  (list "b" "c" "a"))
+(content-test
+  "front already first"
+  (doc-ids (content/move-to-front d "a"))
+  (list "a" "b" "c"))
+
+;; ── no-ops ──
+(content-test
+  "missing id no-op"
+  (doc-ids (content/move-before d "zzz" "a"))
+  (list "a" "b" "c"))
+(content-test
+  "missing target no-op"
+  (doc-ids (content/move-before d "a" "zzz"))
+  (list "a" "b" "c"))
+
+;; ── render after move ──
+(content-test
+  "render after move"
+  (asHTML (content/move-after d "a" "c"))
+  "<p>B</p><p>C</p><p>A</p>")
+
+;; ── reparent: move a top-level block INTO a section ──
+(define
+  nd
+  (doc-append
+    (doc-append (doc-empty "d") (mk-text "p" "P"))
+    (mk-section "s" (list (mk-text "x" "X")))))
+(content-test
+  "move-into: block leaves top level"
+  (doc-ids (content/move-into nd "p" "s" 1))
+  (list "s"))
+(content-test
+  "move-into: block lands in section at index"
+  (doc-tree-ids (content/move-into nd "p" "s" 1))
+  (list "s" "x" "p"))
+(content-test
+  "move-into at front of section"
+  (doc-tree-ids (content/move-into nd "p" "s" 0))
+  (list "s" "p" "x"))
+(content-test "move-into immutable" (doc-tree-ids nd) (list "p" "s" "x"))
+
+;; ── reparent: move a NESTED block to a different section ──
+(define
+  two
+  (doc-append
+    (doc-append (doc-empty "d") (mk-section "s1" (list (mk-text "n" "N"))))
+    (mk-section "s2" (list (mk-text "y" "Y")))))
+(content-test
+  "move-into across sections"
+  (doc-tree-ids (content/move-into two "n" "s2" 1))
+  (list "s1" "s2" "y" "n"))
+
+;; ── promote: nested block out to top level (appended last) ──
+(content-test
+  "promote nested to top level"
+  (doc-tree-ids (content/promote two "n"))
+  (list "s1" "s2" "y" "n"))
+(content-test
+  "promote leaves section empty shell"
+  (doc-ids (content/promote two "n"))
+  (list "s1" "s2" "n"))
+(content-test
+  "promote a whole section keeps its subtree"
+  (doc-tree-ids
+    (content/promote
+      (doc-append
+        (doc-empty "d")
+        (mk-section "o" (list (mk-section "i" (list (mk-text "z" "Z"))))))
+      "i"))
+  (list "o" "i" "z"))
+
+;; ── cycle guard: cannot move a section into its own descendant ──
+(define
+  nest
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "outer"
+      (list (mk-section "inner" (list (mk-text "t" "T")))))))
+(content-test
+  "move section into its own child is a no-op"
+  (doc-tree-ids (content/move-into nest "outer" "inner" 0))
+  (list "outer" "inner" "t"))
+(content-test
+  "move block into itself is a no-op"
+  (doc-tree-ids (content/move-into nest "inner" "inner" 0))
+  (list "outer" "inner" "t"))
+
+;; ── reparent no-ops on missing ids ──
+(content-test
+  "move-into missing block no-op"
+  (doc-tree-ids (content/move-into nd "zzz" "s" 0))
+  (list "p" "s" "x"))
+(content-test
+  "move-into missing section no-op"
+  (doc-tree-ids (content/move-into nd "p" "zzz" 0))
+  (list "p" "s" "x"))
+(content-test
+  "promote missing no-op"
+  (doc-tree-ids (content/promote nd "zzz"))
+  (list "p" "s" "x"))

lib/content/tests/normalize.sx

@@ -0,0 +1,99 @@
+;; Extension — document normalization (drop empty text blocks + empty sections).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+;; ── drop empty text blocks ──
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append (doc-empty "d") (mk-heading "h" 1 "Hi"))
+      (mk-text "empty" ""))
+    (mk-text "p" "Body")))
+(content-test
+  "drops empty text"
+  (doc-ids (content/normalize d))
+  (list "h" "p"))
+(content-test "normalize immutable" (doc-ids d) (list "h" "empty" "p"))
+(content-test
+  "keeps non-empty text"
+  (str (blk-send (doc-find (content/normalize d) "p") "text"))
+  "Body")
+
+;; ── drop empty sections ──
+(define
+  d2
+  (doc-append
+    (doc-append (doc-empty "d") (mk-text "p" "x"))
+    (mk-section "empty-sec" (list))))
+(content-test
+  "drops empty section"
+  (doc-ids (content/normalize d2))
+  (list "p"))
+
+;; ── section that becomes empty (all children dropped) is itself dropped ──
+(define
+  d3
+  (doc-append
+    (doc-empty "d")
+    (mk-section "s" (list (mk-text "e1" "") (mk-text "e2" "")))))
+(content-test
+  "section emptied then dropped"
+  (doc-ids (content/normalize d3))
+  (list))
+
+;; ── section with some content keeps surviving children ──
+(define
+  d4
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "s"
+      (list (mk-text "e" "") (mk-heading "k" 2 "Keep")))))
+(define n4 (content/normalize d4))
+(content-test "section kept" (doc-ids n4) (list "s"))
+(content-test
+  "empty child dropped, real kept"
+  (doc-tree-ids n4)
+  (list "s" "k"))
+
+;; ── nested: empty deep section removed, content bubbles correctly ──
+(define
+  d5
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "outer"
+      (list (mk-text "a" "A") (mk-section "inner" (list (mk-text "x" "")))))))
+(content-test
+  "nested empty inner dropped"
+  (doc-tree-ids (content/normalize d5))
+  (list "outer" "a"))
+
+;; ── already-clean doc unchanged ──
+(define
+  clean
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "T"))
+    (mk-text "p" "B")))
+(content-test
+  "clean doc unchanged ids"
+  (doc-ids (content/normalize clean))
+  (list "h" "p"))
+(content-test
+  "clean doc render"
+  (asHTML (content/normalize clean))
+  (asHTML clean))
+
+;; ── non-text empties preserved (divider, image with empty alt) ──
+(define
+  d6
+  (doc-append
+    (doc-append (doc-empty "d") (mk-divider "dv"))
+    (mk-image "i" "/a.png" "")))
+(content-test
+  "divider + image kept"
+  (doc-ids (content/normalize d6))
+  (list "dv" "i"))

lib/content/tests/outline.sx

@@ -0,0 +1,78 @@
+;; Extension — nested document outline.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+;; H1 / H2 H2 / H1  ->  [h1{children: h2,h3}, h4]
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append
+        (doc-append (doc-empty "d") (mk-heading "a" 1 "A"))
+        (mk-heading "b" 2 "B"))
+      (mk-heading "c" 2 "C"))
+    (mk-heading "e" 1 "E")))
+
+(define o (content/outline d))
+(content-test "outline top count" (len o) 2)
+(content-test "outline first id" (get (first o) :id) "a")
+(content-test
+  "outline first children ids"
+  (map (fn (n) (get n :id)) (get (first o) :children))
+  (list "b" "c"))
+(content-test "outline second top" (get (nth o 1) :id) "e")
+(content-test
+  "outline second no children"
+  (get (nth o 1) :children)
+  (list))
+
+;; ── deeper nesting: H1 / H2 / H3 ──
+(define
+  d2
+  (doc-append
+    (doc-append
+      (doc-append (doc-empty "d") (mk-heading "x" 1 "X"))
+      (mk-heading "y" 2 "Y"))
+    (mk-heading "z" 3 "Z")))
+(define o2 (content/outline d2))
+(content-test "deep top" (get (first o2) :id) "x")
+(content-test
+  "deep child"
+  (get (first (get (first o2) :children)) :id)
+  "y")
+(content-test
+  "deep grandchild"
+  (get (first (get (first (get (first o2) :children)) :children)) :id)
+  "z")
+
+;; ── node carries text + level ──
+(content-test "node text" (get (first o) :text) "A")
+(content-test "node level" (get (first o) :level) 1)
+
+;; ── empty / no headings ──
+(content-test "outline empty" (content/outline (doc-empty "e")) (list))
+(content-test
+  "outline no headings"
+  (content/outline (doc-append (doc-empty "d") (mk-text "p" "x")))
+  (list))
+
+;; ── starting at H2 (no H1) still forms a forest ──
+(define
+  d3
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "p" 2 "P"))
+    (mk-heading "q" 2 "Q")))
+(content-test "no-h1 forest count" (len (content/outline d3)) 2)
+
+;; ── headings nested inside sections are found (tree-wide via query) ──
+(define
+  d4
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "top" 1 "Top"))
+    (mk-section "s" (list (mk-heading "in" 2 "In")))))
+(content-test
+  "section heading nested in outline"
+  (map (fn (n) (get n :id)) (get (first (content/outline d4)) :children))
+  (list "in"))

lib/content/tests/page-full.sx

@@ -0,0 +1,39 @@
+;; Extension — SEO-complete HTML page (lang + meta description).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-text!)
+
+(define
+  d
+  (doc-with-title
+    (doc-append
+      (doc-append (doc-empty "post") (mk-heading "h" 1 "Hi"))
+      (mk-text "p" "Hello world"))
+    "My Title"))
+
+(content-test
+  "page-full"
+  (content/page-full d)
+  "<!doctype html><html lang=\"en\"><head><meta charset=\"utf-8\"><title>My Title</title><meta name=\"description\" content=\"Hi Hello world\"></head><body><h1>Hi</h1><p>Hello world</p></body></html>")
+
+;; description escaped
+(content-test
+  "page-full escapes description"
+  (content/page-full
+    (doc-with-title
+      (doc-append (doc-empty "x") (mk-text "p" "a < b & c"))
+      "T"))
+  "<!doctype html><html lang=\"en\"><head><meta charset=\"utf-8\"><title>T</title><meta name=\"description\" content=\"a &lt; b &amp; c\"></head><body><p>a &lt; b &amp; c</p></body></html>")
+
+;; title falls back to id, empty description for empty doc
+(content-test
+  "page-full empty"
+  (content/page-full (doc-empty "fallback"))
+  "<!doctype html><html lang=\"en\"><head><meta charset=\"utf-8\"><title>fallback</title><meta name=\"description\" content=\"\"></head><body></body></html>")
+
+;; body reflects edits
+(content-test
+  "page-full reflects edits"
+  (content/page-full (doc-update d "p" "text" "Bye now"))
+  "<!doctype html><html lang=\"en\"><head><meta charset=\"utf-8\"><title>My Title</title><meta name=\"description\" content=\"Hi Bye now\"></head><body><h1>Hi</h1><p>Bye now</p></body></html>")

lib/content/tests/page.sx

@@ -0,0 +1,42 @@
+;; Extension — full HTML page wrapper.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+
+(define
+  d
+  (doc-with-title
+    (doc-append (doc-empty "post") (mk-heading "h" 1 "Hi"))
+    "My Title"))
+
+(content-test
+  "page"
+  (content/page d)
+  "<!doctype html><html><head><meta charset=\"utf-8\"><title>My Title</title></head><body><h1>Hi</h1></body></html>")
+
+(content-test
+  "page title escaped"
+  (content/page (doc-with-title (doc-empty "x") "A < B"))
+  "<!doctype html><html><head><meta charset=\"utf-8\"><title>A &lt; B</title></head><body></body></html>")
+
+(content-test
+  "page falls back to id"
+  (content/page (doc-empty "fallback"))
+  "<!doctype html><html><head><meta charset=\"utf-8\"><title>fallback</title></head><body></body></html>")
+
+(content-test "page-title from meta" (content/page-title d) "My Title")
+(content-test
+  "page-title fallback id"
+  (content/page-title (doc-empty "z"))
+  "z")
+
+(content-test
+  "page body reflects edits"
+  (content/page (doc-update d "h" "text" "Bye"))
+  "<!doctype html><html><head><meta charset=\"utf-8\"><title>My Title</title></head><body><h1>Bye</h1></body></html>")
+
+(content-test
+  "page multi-block body"
+  (content/page
+    (doc-append (doc-with-title (doc-empty "p") "T") (mk-text "x" "para")))
+  "<!doctype html><html><head><meta charset=\"utf-8\"><title>T</title></head><body><p>para</p></body></html>")

lib/content/tests/query.sx

@@ -0,0 +1,138 @@
+;; Extension — block query + table of contents + prose search.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-text!)
+(content-bootstrap-section!)
+(content-bootstrap-table!)
+(content-bootstrap-callout!)
+
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append
+        (doc-append (doc-empty "d") (mk-heading "h1" 1 "Intro"))
+        (mk-text "p1" "para"))
+      (mk-image "img" "/a.png" "alt"))
+    (mk-section
+      "s"
+      (list
+        (mk-heading "h2" 2 "Sub")
+        (mk-text "p2" "more")
+        (mk-image "img2" "/b.png" "b")))))
+
+;; ── select-type (tree-wide) ──
+(content-test
+  "select headings ids"
+  (map (fn (b) (blk-id b)) (content/select-type d "heading"))
+  (list "h1" "h2"))
+(content-test
+  "select images ids"
+  (map (fn (b) (blk-id b)) (content/select-type d "image"))
+  (list "img" "img2"))
+(content-test
+  "select text ids"
+  (map (fn (b) (blk-id b)) (content/select-type d "text"))
+  (list "p1" "p2"))
+(content-test
+  "select section ids"
+  (map (fn (b) (blk-id b)) (content/select-type d "section"))
+  (list "s"))
+
+;; ── count-type ──
+(content-test "count headings" (content/count-type d "heading") 2)
+(content-test "count images" (content/count-type d "image") 2)
+(content-test "count dividers" (content/count-type d "divider") 0)
+
+;; ── select with custom predicate ──
+(content-test
+  "select-ids custom"
+  (content/select-ids d (fn (b) (= (blk-type b) "image")))
+  (list "img" "img2"))
+(content-test
+  "select custom field"
+  (map
+    (fn (b) (blk-id b))
+    (content/select
+      d
+      (fn
+        (b)
+        (if
+          (= (blk-type b) "heading")
+          (= (blk-get b "level") 2)
+          false))))
+  (list "h2"))
+
+;; ── headings / TOC ──
+(content-test
+  "headings TOC"
+  (content/headings d)
+  (list {:id "h1" :text "Intro" :level 1} {:id "h2" :text "Sub" :level 2}))
+(content-test
+  "empty doc no headings"
+  (content/headings (doc-empty "e"))
+  (list))
+
+;; ── deeply nested ──
+(define
+  deep
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "o"
+      (list (mk-section "i" (list (mk-heading "deep" 3 "Deep")))))))
+(content-test
+  "deep heading found"
+  (map (fn (b) (blk-id b)) (content/select-type deep "heading"))
+  (list "deep"))
+(content-test
+  "deep toc level"
+  (get (first (content/headings deep)) :level)
+  3)
+
+;; ── prose search (content/search-text) ──
+;; "cat" appears in text, image alt, a list item, a table cell, and a callout
+;; — every text-bearing field — so search must find all five via asText.
+(define
+  sd
+  (doc-append
+    (doc-append
+      (doc-append
+        (doc-append
+          (doc-append
+            (doc-empty "sd")
+            (mk-heading "sh" 1 "Welcome aboard"))
+          (mk-text "st" "the cat sat"))
+        (mk-image "si" "/x.png" "a cat photo"))
+      (mk-list "sl" false (list "first cat" "second dog")))
+    (mk-section
+      "sec"
+      (list
+        (mk-table "stb" (list "Animal") (list (list "cat") (list "fish")))
+        (mk-callout "sc" "note" "beware of cat")))))
+
+(content-test
+  "search across every text-bearing field"
+  (content/search-text-ids sd "cat")
+  (list "st" "si" "sl" "stb" "sc"))
+(content-test "search count" (len (content/search-text sd "cat")) 5)
+(content-test
+  "search heading text"
+  (content/search-text-ids sd "Welcome")
+  (list "sh"))
+(content-test
+  "search list item only"
+  (content/search-text-ids sd "dog")
+  (list "sl"))
+(content-test "search no match" (content/search-text-ids sd "zzz") (list))
+;; section containers are excluded — a term living only inside a section's
+;; children returns the child, never the section wrapper.
+(content-test
+  "search excludes section wrapper"
+  (content/search-text-ids sd "fish")
+  (list "stb"))
+(content-test
+  "search returns block objects"
+  (blk-id (first (content/search-text sd "Welcome")))
+  "sh")

lib/content/tests/render.sx

@@ -0,0 +1,135 @@
+;; Phase 1 — render boundary. asHTML / asSx are polymorphic message sends on
+;; blocks and the document. Escaping happens at the boundary.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-render!)
+
+(define h (mk-heading "h" 2 "Title"))
+(define p (mk-text "p" "Hello"))
+(define code (mk-code "c" "sx" "(+ 1 2)"))
+(define q (mk-quote "q" "Ada" "to err"))
+(define img (mk-image "i" "/c.png" "cat"))
+(define em (mk-embed "e" "https://v/1" "vimeo"))
+(define dv (mk-divider "d"))
+(define ul (mk-list "u" false (list "a" "b")))
+(define ol (mk-list "o" true (list "x" "y")))
+
+;; ── per-block asHTML ──
+(content-test "heading html" (asHTML h) "<h2>Title</h2>")
+(content-test "text html" (asHTML p) "<p>Hello</p>")
+(content-test
+  "code html"
+  (asHTML code)
+  "<pre><code class=\"language-sx\">(+ 1 2)</code></pre>")
+(content-test "quote html" (asHTML q) "<blockquote>to err</blockquote>")
+(content-test "image html" (asHTML img) "<img src=\"/c.png\" alt=\"cat\">")
+(content-test "embed html" (asHTML em) "<iframe src=\"https://v/1\"></iframe>")
+(content-test "divider html" (asHTML dv) "<hr>")
+(content-test "ul html" (asHTML ul) "<ul><li>a</li><li>b</li></ul>")
+(content-test "ol html" (asHTML ol) "<ol><li>x</li><li>y</li></ol>")
+
+;; ── per-block asSx ──
+(content-test "heading sx" (asSx h) "(h2 \"Title\")")
+(content-test "text sx" (asSx p) "(p \"Hello\")")
+(content-test "code sx" (asSx code) "(pre (code \"(+ 1 2)\"))")
+(content-test "quote sx" (asSx q) "(blockquote \"to err\")")
+(content-test "image sx" (asSx img) "(img :src \"/c.png\" :alt \"cat\")")
+(content-test "embed sx" (asSx em) "(iframe :src \"https://v/1\")")
+(content-test "divider sx" (asSx dv) "(hr)")
+(content-test "ul sx" (asSx ul) "(ul (li \"a\")(li \"b\"))")
+(content-test "ol sx" (asSx ol) "(ol (li \"x\")(li \"y\"))")
+
+;; ── document folds children (pure message dispatch) ──
+(define d (doc-append (doc-append (doc-append (doc-empty "doc") h) p) dv))
+(content-test "doc html" (asHTML d) "<h2>Title</h2><p>Hello</p><hr>")
+(content-test "doc sx" (asSx d) "(article (h2 \"Title\")(p \"Hello\")(hr))")
+(content-test "empty doc html" (asHTML (doc-empty "e")) "")
+(content-test "empty doc sx" (asSx (doc-empty "e")) "(article )")
+
+;; ── render-* / block-* aliases ──
+(content-test "render-html alias" (render-html d) (asHTML d))
+(content-test "render-sx alias" (render-sx d) (asSx d))
+(content-test "block-html alias" (block-html h) "<h2>Title</h2>")
+
+;; ── render reflects edits (immutability: each render is of a version) ──
+(define d2 (doc-update d "p" "text" "Edited"))
+(content-test
+  "render after update"
+  (asHTML d2)
+  "<h2>Title</h2><p>Edited</p><hr>")
+(content-test
+  "original render unchanged"
+  (asHTML d)
+  "<h2>Title</h2><p>Hello</p><hr>")
+(content-test
+  "render after move"
+  (asHTML (doc-move d "h" 2))
+  "<p>Hello</p><hr><h2>Title</h2>")
+(content-test
+  "render after delete"
+  (asHTML (doc-delete d "p"))
+  "<h2>Title</h2><hr>")
+
+;; ── HTML escaping at the boundary ──
+(define xh (mk-heading "xh" 2 "A < B & \"C\""))
+(define xp (mk-text "xp" "<script>alert(1)</script>"))
+(define xi (mk-image "xi" "/a.png?x=1&y=2" "tag <b>"))
+(define xl (mk-list "xl" false (list "a<1" "b&2")))
+(content-test
+  "escape heading text"
+  (asHTML xh)
+  "<h2>A &lt; B &amp; &quot;C&quot;</h2>")
+(content-test
+  "escape paragraph"
+  (asHTML xp)
+  "<p>&lt;script&gt;alert(1)&lt;/script&gt;</p>")
+(content-test
+  "escape image attrs"
+  (asHTML xi)
+  "<img src=\"/a.png?x=1&amp;y=2\" alt=\"tag &lt;b&gt;\">")
+(content-test
+  "escape list items"
+  (asHTML xl)
+  "<ul><li>a&lt;1</li><li>b&amp;2</li></ul>")
+(content-test
+  "escape ampersand once"
+  (asHTML (mk-text "amp" "a & b"))
+  "<p>a &amp; b</p>")
+(content-test
+  "escape in document"
+  (asHTML (doc-append (doc-empty "e") xp))
+  "<p>&lt;script&gt;alert(1)&lt;/script&gt;</p>")
+(content-test
+  "no over-escape plain"
+  (asHTML (mk-text "plain" "hello world"))
+  "<p>hello world</p>")
+(content-test
+  "escape code body"
+  (asHTML (mk-code "xc" "html" "<div> & </div>"))
+  "<pre><code class=\"language-html\">&lt;div&gt; &amp; &lt;/div&gt;</code></pre>")
+
+;; ── asSx string-escaping (build expected via q/bs to avoid miscounts) ──
+(define q1 (str "\""))
+(define bs (str "\\"))
+(content-test
+  "asSx escapes quote"
+  (asSx (mk-text "qt" (str "say " q1 "hi" q1)))
+  (str "(p " q1 "say " bs q1 "hi" bs q1 q1 ")"))
+(content-test
+  "asSx escapes backslash"
+  (asSx (mk-text "qb" (str "a" bs "b")))
+  (str "(p " q1 "a" bs bs "b" q1 ")"))
+(content-test
+  "asSx plain unchanged"
+  (asSx (mk-text "pp" "plain"))
+  "(p \"plain\")")
+(content-test
+  "asSx escapes image attr"
+  (asSx (mk-image "im" (str "/a" q1) "x"))
+  (str "(img :src " q1 "/a" bs q1 q1 " :alt " q1 "x" q1 ")"))
+(content-test
+  "asSx escapes list item"
+  (asSx (mk-list "lq" false (list (str "i" q1) "j")))
+  (str "(ul (li " q1 "i" bs q1 q1 ")(li " q1 "j" q1 "))"))

lib/content/tests/runs.sx

@@ -0,0 +1,227 @@
+;; Phase 5 — rich inline text (structured runs). Acceptance suite.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-text!)
+(content-bootstrap-section!)
+(content-bootstrap-runs!)
+
+;; one-run helper: a CtText with a single marked run
+(define
+  one
+  (fn (marks href) (mk-rich-text "p" (list (mk-run "x" marks href)))))
+
+;; ── (1) four render modes ──
+;; a paragraph mixing plain + bold + a link
+(define
+  rd
+  (doc-append
+    (doc-empty "d")
+    (mk-rich-text
+      "p"
+      (list
+        (mk-run "the " (list) "")
+        (mk-run "cat" (list :bold) "")
+        (mk-run " and " (list) "")
+        (mk-run "dog" (list :italic :link) "/d")
+        (mk-run " sat" (list) "")))))
+(define p (doc-find rd "p"))
+(content-test
+  "asHTML rich"
+  (asHTML rd)
+  "<p>the <strong>cat</strong> and <a href=\"/d\"><em>dog</em></a> sat</p>")
+(content-test
+  "asMarkdown rich"
+  (asMarkdown rd)
+  "the **cat** and [_dog_](/d) sat")
+(content-test
+  "asSx rich"
+  (asSx rd)
+  "(article (p \"the \" (strong \"cat\") \" and \" (a :href \"/d\" (em \"dog\")) \" sat\"))")
+(content-test
+  "asText rich is plain (no markup)"
+  (asText rd)
+  "the cat and dog sat")
+
+;; every mark renders in HTML
+(content-test
+  "mark bold html"
+  (asHTML (one (list :bold) ""))
+  "<p><strong>x</strong></p>")
+(content-test
+  "mark italic html"
+  (asHTML (one (list :italic) ""))
+  "<p><em>x</em></p>")
+(content-test
+  "mark underline html"
+  (asHTML (one (list :underline) ""))
+  "<p><u>x</u></p>")
+(content-test
+  "mark strike html"
+  (asHTML (one (list :strikethrough) ""))
+  "<p><s>x</s></p>")
+(content-test
+  "mark code html"
+  (asHTML (one (list :code) ""))
+  "<p><code>x</code></p>")
+(content-test
+  "mark sub html"
+  (asHTML (one (list :subscript) ""))
+  "<p><sub>x</sub></p>")
+(content-test
+  "mark sup html"
+  (asHTML (one (list :superscript) ""))
+  "<p><sup>x</sup></p>")
+(content-test
+  "mark link html"
+  (asHTML (one (list :link) "/u"))
+  "<p><a href=\"/u\">x</a></p>")
+
+;; markdown marks
+(content-test "mark bold md" (asMarkdown (one (list :bold) "")) "**x**")
+(content-test "mark italic md" (asMarkdown (one (list :italic) "")) "_x_")
+(content-test
+  "mark strike md"
+  (asMarkdown (one (list :strikethrough) ""))
+  "~~x~~")
+(content-test "mark code md" (asMarkdown (one (list :code) "")) "`x`")
+(content-test "mark link md" (asMarkdown (one (list :link) "/u")) "[x](/u)")
+(content-test
+  "mark underline md fallback"
+  (asMarkdown (one (list :underline) ""))
+  "<u>x</u>")
+
+;; nested marks (bold+italic) — deterministic nesting order
+(content-test
+  "nested marks html"
+  (asHTML (one (list :bold :italic) ""))
+  "<p><em><strong>x</strong></em></p>")
+
+;; escaping still happens inside runs
+(content-test
+  "run text escaped html"
+  (asHTML (mk-rich-text "p" (list (mk-run "a & b <c>" (list :bold) ""))))
+  "<p><strong>a &amp; b &lt;c&gt;</strong></p>")
+
+;; rich heading + quote + code
+(content-test
+  "rich heading html"
+  (asHTML
+    (st-iv-set!
+      (mk-heading "h" 2 "")
+      "text"
+      (list (mk-run "Big " (list) "") (mk-run "bold" (list :bold) ""))))
+  "<h2>Big <strong>bold</strong></h2>")
+(content-test
+  "rich quote html"
+  (asHTML
+    (st-iv-set!
+      (mk-quote "q" "" "")
+      "text"
+      (list (mk-run "wise" (list :italic) ""))))
+  "<blockquote><em>wise</em></blockquote>")
+;; code is verbatim — runs concatenate as plain text, marks ignored
+(content-test
+  "code runs plain html"
+  (asHTML
+    (st-iv-set!
+      (mk-code "c" "py" "")
+      "text"
+      (list (mk-run "a=" (list :bold) "") (mk-run "1" (list) ""))))
+  "<pre><code class=\"language-py\">a=1</code></pre>")
+
+;; ── (2) backward compat: plain-string CtText unchanged ──
+(content-test
+  "plain html"
+  (asHTML (mk-text "q" "hi & <b>"))
+  "<p>hi &amp; &lt;b&gt;</p>")
+(content-test "plain sx" (asSx (mk-text "q" "hi")) "(p \"hi\")")
+(content-test "plain md" (asMarkdown (mk-text "q" "hi")) "hi")
+(content-test "plain text" (asText (mk-text "q" "hi")) "hi")
+(content-test
+  "plain heading html"
+  (asHTML (mk-heading "h" 3 "T"))
+  "<h3>T</h3>")
+
+;; ── (3) find-replace across runs (per-run, marks preserved) ──
+(define
+  frd
+  (doc-append
+    (doc-empty "d")
+    (mk-rich-text
+      "p"
+      (list
+        (mk-run "the Foo" (list :bold) "")
+        (mk-run " and Foo here" (list) "")))))
+(define frr (content/find-replace frd "Foo" "Bar"))
+(content-test
+  "find-replace rich plain text"
+  (asText frr)
+  "the Bar and Bar here")
+(content-test
+  "find-replace rich preserves marks"
+  (asHTML frr)
+  "<p><strong>the Bar</strong> and Bar here</p>")
+(content-test
+  "find-replace rich run0 still bold"
+  (nth (nth (blk-get (doc-find frr "p") "text") 0) 1)
+  (list "bold"))
+
+;; ── (4) search-text via asText, across run boundary ──
+;; "cat sat" spans run1 ("the cat") and run2 (" sat")
+(define
+  sd
+  (doc-append
+    (doc-empty "d")
+    (mk-rich-text
+      "p"
+      (list (mk-run "the cat" (list :bold) "") (mk-run " sat" (list) "")))))
+(content-test
+  "search finds substring across runs"
+  (content/search-text-ids sd "cat sat")
+  (list "p"))
+(content-test "search miss" (content/search-text-ids sd "zzz") (list))
+
+;; ── (5) CRDT invariant — runs are an opaque block-level value ──
+(define ra (list (mk-run "x" (list :bold) "")))
+(define rb (list (mk-run "y" (list :italic) "")))
+(define
+  s1
+  (crdt-insert
+    (crdt-empty)
+    "p"
+    "text"
+    (crdt-pos 5 "a")
+    {:text ra}
+    1
+    "a"))
+(define s2 (crdt-update s1 "p" "text" rb 2 "b"))
+(content-test
+  "crdt merge commutes with runs"
+  (get (crdt-merge s1 s2) :elements)
+  (get (crdt-merge s2 s1) :elements))
+(content-test
+  "crdt merge idempotent with runs"
+  (get (crdt-merge s2 s2) :elements)
+  (get s2 :elements))
+;; LWW: later ts (rb, ts 2) wins; runs survive as the field value
+(content-test
+  "crdt LWW keeps latest runs"
+  (asHTML
+    (crdt-element->block (get (get (crdt-merge s1 s2) :elements) "p")))
+  "<p><em>y</em></p>")
+
+;; ── (6) data + wire round-trip runs losslessly ──
+(content-test
+  "data round-trip rich html"
+  (asHTML (content/from-data (content/to-data rd)))
+  (asHTML rd))
+(content-test
+  "data round-trip rich text"
+  (asText (content/from-data (content/to-data rd)))
+  "the cat and dog sat")
+(content-test
+  "wire round-trip rich html"
+  (asHTML (content/from-wire (content/to-wire rd)))
+  (asHTML rd))

lib/content/tests/sanitize.sx

@@ -0,0 +1,128 @@
+;; Extension — make a document render-safe by dropping invalid blocks.
+;; Counterpart to validate; reuses its per-block checks. Tree-wide.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-section!)
+
+;; ── a valid document is returned unchanged (same ids, tree order) ──
+(define
+  good
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "Title"))
+    (mk-text "p" "Body")))
+(content-test
+  "valid doc keeps all blocks"
+  (doc-ids (content/sanitize good))
+  (list "h" "p"))
+(content-test
+  "valid doc still valid after sanitize"
+  (content/valid? (content/sanitize good))
+  true)
+
+;; ── a block with a bad field is dropped ──
+(content-test
+  "bad-field block dropped"
+  (doc-ids
+    (content/sanitize
+      (doc-append
+        (doc-append (doc-empty "d") (mk-text "ok" "fine"))
+        (mk-heading "bad" "notnum" "T"))))
+  (list "ok"))
+
+;; ── unknown block type dropped ──
+(define raw (st-iv-set! (st-make-instance "CtBlock") "id" "z"))
+(content-test
+  "unknown-type block dropped"
+  (doc-ids
+    (content/sanitize
+      (doc-append (doc-append (doc-empty "d") (mk-text "ok" "x")) raw)))
+  (list "ok"))
+
+;; ── blank-id block dropped ──
+(content-test
+  "blank-id block dropped"
+  (doc-ids
+    (content/sanitize
+      (doc-append
+        (doc-append (doc-empty "d") (mk-text "ok" "x"))
+        (mk-text "" "y"))))
+  (list "ok"))
+
+;; ── result is render-safe: no id/field issues remain ──
+(content-test
+  "sanitized has no field/id issues"
+  (len
+    (filter
+      (fn (i) (if (= (get i :kind) "field") true (= (get i :kind) "id")))
+      (content/validate
+        (content/sanitize
+          (doc-append
+            (doc-append (doc-empty "d") (mk-text "ok" "x"))
+            (mk-heading "bad" "notnum" "T"))))))
+  0)
+
+;; ── immutability: original document untouched ──
+(define
+  withbad
+  (doc-append
+    (doc-append (doc-empty "d") (mk-text "ok" "x"))
+    (mk-heading "bad" "notnum" "T")))
+(define _ (content/sanitize withbad))
+(content-test "original unchanged" (doc-ids withbad) (list "ok" "bad"))
+
+;; ── tree-wide: invalid nested child pruned, valid sibling + section kept ──
+(define
+  nested
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "s"
+      (list (mk-text "good" "keep") (mk-heading "badc" "notnum" "X")))))
+(content-test
+  "invalid nested child pruned, section kept"
+  (doc-tree-ids (content/sanitize nested))
+  (list "s" "good"))
+
+;; ── a section whose own shell is invalid (children not a list) is dropped ──
+(define
+  badsec
+  (doc-append
+    (doc-append (doc-empty "d") (mk-text "ok" "x"))
+    (st-iv-set! (mk-section "s" (list)) "children" "nope")))
+(content-test
+  "invalid section shell dropped whole"
+  (doc-tree-ids (content/sanitize badsec))
+  (list "ok"))
+
+;; ── a valid section that loses all children is kept (empty) — sanitize is not
+;; normalize; it removes invalid, not empty ──
+(define
+  allbadchildren
+  (doc-append
+    (doc-empty "d")
+    (mk-section "s" (list (mk-heading "b1" "x" "X") (mk-text "" "y")))))
+(content-test
+  "section kept though emptied of invalid children"
+  (doc-tree-ids (content/sanitize allbadchildren))
+  (list "s"))
+
+;; ── deeply nested: invalid block two levels down is pruned ──
+(define
+  deep
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "o"
+      (list (mk-section "i" (list (mk-text "dok" "x") (mk-text "" "bad")))))))
+(content-test
+  "deep invalid pruned"
+  (doc-tree-ids (content/sanitize deep))
+  (list "o" "i" "dok"))
+
+;; ── empty document sanitizes to empty ──
+(content-test
+  "empty doc stays empty"
+  (doc-ids (content/sanitize (doc-empty "e")))
+  (list))

lib/content/tests/section.sx

@@ -0,0 +1,99 @@
+;; Extension — nested block trees (CtSection container).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-text!)
+(content-bootstrap-section!)
+
+(define nl (str "\n"))
+
+;; ── a section is a block ──
+(define
+  sec
+  (mk-section
+    "s"
+    (list (mk-heading "h" 2 "Hi") (mk-text "p" "Body"))))
+(content-test "section is block" (block? sec) true)
+(content-test "section? yes" (section? sec) true)
+(content-test "section? no on text" (section? (mk-text "x" "y")) false)
+(content-test "section type" (blk-type sec) "section")
+(content-test "section id" (blk-id sec) "s")
+(content-test
+  "section children count"
+  (len (section-children sec))
+  2)
+
+;; ── recursive render ──
+(content-test
+  "section html"
+  (asHTML sec)
+  "<section><h2>Hi</h2><p>Body</p></section>")
+(content-test "section sx" (asSx sec) "(section (h2 \"Hi\")(p \"Body\"))")
+(content-test "section text" (asText sec) "Hi Body")
+(content-test
+  "empty section html"
+  (asHTML (mk-section "e" (list)))
+  "<section></section>")
+
+;; ── nested in a document ──
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "top" 1 "Top"))
+    sec))
+(content-test
+  "doc with section html"
+  (asHTML d)
+  "<h1>Top</h1><section><h2>Hi</h2><p>Body</p></section>")
+(content-test "doc top-level ids" (doc-ids d) (list "top" "s"))
+
+;; ── arbitrary depth ──
+(define
+  deep
+  (mk-section
+    "outer"
+    (list
+      (mk-text "a" "A")
+      (mk-section
+        "inner"
+        (list (mk-text "b" "B") (mk-heading "c" 3 "C"))))))
+(content-test
+  "deep html"
+  (asHTML deep)
+  "<section><p>A</p><section><p>B</p><h3>C</h3></section></section>")
+(content-test "deep text" (asText deep) "A B C")
+
+;; ── tree traversal descends into sections ──
+(define dd (doc-append (doc-empty "d") deep))
+(content-test "deep-find nested" (blk-id (doc-deep-find dd "b")) "b")
+(content-test
+  "deep-find deeper"
+  (str (blk-send (doc-deep-find dd "c") "text"))
+  "C")
+(content-test "deep-find missing" (doc-deep-find dd "zzz") nil)
+(content-test
+  "deep-find top-level"
+  (blk-id (doc-deep-find dd "outer"))
+  "outer")
+(content-test
+  "tree-ids flattened"
+  (doc-tree-ids dd)
+  (list "outer" "a" "inner" "b" "c"))
+(content-test "tree-count" (doc-tree-count dd) 5)
+(content-test "top-level ids still flat" (doc-ids dd) (list "outer"))
+
+;; ── copy-on-write child edits ──
+(define sec2 (section-append sec (mk-divider "dv")))
+(content-test "section-append" (len (section-children sec2)) 3)
+(content-test
+  "section-append immutable"
+  (len (section-children sec))
+  2)
+(content-test
+  "section-append renders"
+  (asHTML sec2)
+  "<section><h2>Hi</h2><p>Body</p><hr></section>")
+
+;; ── markdown of a section (children joined by blank line) ──
+(content-test "section markdown" (asMarkdown sec) (str "## Hi" nl nl "Body"))

lib/content/tests/snapshot.sx

@@ -0,0 +1,100 @@
+;; Extension — snapshot cache over op-log replay. The cache is transparent:
+;; cached reads equal full replays.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+
+(define B (persist/open))
+(define h (mk-heading "h" 1 "T"))
+(define p (mk-text "p" "Body"))
+(define img (mk-image "img" "/c.png" "cat"))
+
+(content/commit! B "post" (op-insert h nil) 1)
+(content/commit! B "post" (op-insert p "h") 2)
+(content/commit! B "post" (op-insert img "h") 3)
+(content/commit! B "post" (op-update "p" "text" "Edited") 4)
+
+;; ── no snapshot yet: cached == full replay ──
+(content-test
+  "no snapshot head-cached == head"
+  (doc-ids (content/head-cached B "post"))
+  (doc-ids (content/head B "post")))
+(content-test
+  "has-snapshot? false initially"
+  (content/has-snapshot? B "post")
+  false)
+(content-test
+  "snapshot-seq 0 initially"
+  (content/snapshot-seq B "post")
+  0)
+
+;; ── take a snapshot at seq 4 ──
+(content-test "snapshot returns seq" (content/snapshot! B "post") 4)
+(content-test "has-snapshot? true" (content/has-snapshot? B "post") true)
+(content-test "snapshot-seq is 4" (content/snapshot-seq B "post") 4)
+
+;; cached head equals full head right after snapshot
+(content-test
+  "head-cached == head after snap"
+  (doc-ids (content/head-cached B "post"))
+  (list "h" "img" "p"))
+(content-test
+  "head-cached p value"
+  (str (blk-send (doc-find (content/head-cached B "post") "p") "text"))
+  "Edited")
+
+;; ── commit more after the snapshot; cached head replays only the tail ──
+(content/commit! B "post" (op-delete "img") 5)
+(content/commit! B "post" (op-insert (mk-text "q" "New") "p") 6)
+(content-test
+  "head-cached reflects post-snapshot ops"
+  (doc-ids (content/head-cached B "post"))
+  (doc-ids (content/head B "post")))
+(content-test
+  "head-cached order"
+  (doc-ids (content/head-cached B "post"))
+  (list "h" "p" "q"))
+
+;; ── at-cached transparency across versions ──
+(content-test
+  "at-cached seq2 (before snap) == at"
+  (doc-ids (content/at-cached B "post" 2))
+  (doc-ids (content/at B "post" 2)))
+(content-test
+  "at-cached seq5 (after snap) == at"
+  (doc-ids (content/at-cached B "post" 5))
+  (doc-ids (content/at B "post" 5)))
+(content-test
+  "at-cached seq6 == at"
+  (doc-ids (content/at-cached B "post" 6))
+  (doc-ids (content/at B "post" 6)))
+(content-test
+  "at-cached seq4 == snapshot version"
+  (doc-ids (content/at-cached B "post" 4))
+  (list "h" "img" "p"))
+
+;; ── re-snapshot moves the cache forward ──
+(content-test "re-snapshot seq" (content/snapshot! B "post") 6)
+(content-test
+  "head-cached still correct after resnap"
+  (doc-ids (content/head-cached B "post"))
+  (list "h" "p" "q"))
+
+;; ── drop snapshot falls back to full replay, same result ──
+(content/drop-snapshot! B "post")
+(content-test "snapshot dropped" (content/has-snapshot? B "post") false)
+(content-test
+  "head-cached == head after drop"
+  (doc-ids (content/head-cached B "post"))
+  (doc-ids (content/head B "post")))
+
+;; ── snapshot of empty / fresh doc ──
+(content-test
+  "snapshot empty doc seq 0"
+  (content/snapshot! B "empty")
+  0)
+(content-test
+  "head-cached empty"
+  (doc-ids (content/head-cached B "empty"))
+  (list))

lib/content/tests/stats.sx

@@ -0,0 +1,68 @@
+;; Extension — document statistics.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-text!)
+(content-bootstrap-section!)
+
+;; ── empty doc ──
+(define e (doc-empty "e"))
+(content-test "empty words" (content/word-count e) 0)
+(content-test "empty chars" (content/char-count e) 0)
+(content-test "empty blocks" (content/block-count e) 0)
+(content-test "empty reading" (content/reading-minutes e) 0)
+(content-test "empty stats" (content/stats e) {:blocks 0 :reading-minutes 0 :words 0 :chars 0})
+
+;; ── simple doc ──
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "Hello World"))
+    (mk-text "p" "one two three")))
+(content-test "word count" (content/word-count d) 5)
+(content-test
+  "char count"
+  (content/char-count d)
+  (string-length "Hello World one two three"))
+(content-test "block count" (content/block-count d) 2)
+(content-test "reading rounds up" (content/reading-minutes d) 1)
+
+;; ── reading time at 0 vs 1 word ──
+(content-test
+  "one word one minute"
+  (content/reading-minutes (doc-append (doc-empty "d") (mk-text "p" "hi")))
+  1)
+
+;; ── block count includes nested section children ──
+(define
+  nested
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "s"
+      (list (mk-heading "nh" 1 "A") (mk-text "np" "b c")))))
+(content-test
+  "block count counts section + children"
+  (content/block-count nested)
+  3)
+(content-test
+  "word count descends into section"
+  (content/word-count nested)
+  3)
+
+;; ── deep nesting ──
+(define
+  deep
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "o"
+      (list (mk-text "a" "x") (mk-section "i" (list (mk-text "b" "y z")))))))
+(content-test "deep block count" (content/block-count deep) 4)
+(content-test "deep word count" (content/word-count deep) 3)
+
+;; ── stats dict shape ──
+(define s (content/stats d))
+(content-test "stats words" (get s :words) 5)
+(content-test "stats blocks" (get s :blocks) 2)
+(content-test "stats has reading" (get s :reading-minutes) 1)

lib/content/tests/store.sx

@@ -0,0 +1,208 @@
+;; Phase 2 — op log + versioning over persist. The log is the source of truth;
+;; any version is a replay of the op stream up to a seq.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+
+(define B (persist/open))
+(define h (mk-heading "h" 1 "Title"))
+(define p (mk-text "p" "Body"))
+(define img (mk-image "img" "/c.png" "cat"))
+
+;; ── commit an op stream ──
+(content/commit! B "post" (op-insert h nil) 10)
+(content/commit! B "post" (op-insert p "h") 11)
+(content/commit! B "post" (op-insert img "h") 12)
+(content/commit! B "post" (op-update "p" "text" "Edited") 13)
+(content/commit! B "post" (op-delete "img") 14)
+
+(content-test "version-count" (content/version-count B "post") 5)
+(content-test "log length" (len (content/log B "post")) 5)
+
+;; ── head: latest materialised document ──
+(content-test "head ids" (doc-ids (content/head B "post")) (list "h" "p"))
+(content-test
+  "head p edited"
+  (str (blk-send (doc-find (content/head B "post") "p") "text"))
+  "Edited")
+
+;; ── replay to any version ──
+(content-test
+  "at seq1"
+  (doc-ids (content/at B "post" 1))
+  (list "h"))
+(content-test
+  "at seq2"
+  (doc-ids (content/at B "post" 2))
+  (list "h" "p"))
+(content-test
+  "at seq3"
+  (doc-ids (content/at B "post" 3))
+  (list "h" "img" "p"))
+(content-test
+  "at seq3 p original"
+  (str (blk-send (doc-find (content/at B "post" 3) "p") "text"))
+  "Body")
+(content-test
+  "at seq4 p edited"
+  (str (blk-send (doc-find (content/at B "post" 4) "p") "text"))
+  "Edited")
+(content-test
+  "at seq5 img gone"
+  (doc-ids (content/at B "post" 5))
+  (list "h" "p"))
+(content-test
+  "at seq0 empty"
+  (doc-ids (content/at B "post" 0))
+  (list))
+
+;; ── ops accessor ──
+(content-test
+  "ops kinds"
+  (map (fn (o) (get o :op)) (content/ops B "post"))
+  (list "insert" "insert" "insert" "update" "delete"))
+
+;; ── history metadata ──
+(define hist (content/history B "post"))
+(content-test "history length" (len hist) 5)
+(content-test "history first seq" (get (first hist) :seq) 1)
+(content-test "history first type" (get (first hist) :type) "insert")
+(content-test "history first at" (get (first hist) :at) 10)
+(content-test
+  "history fourth type"
+  (get (nth hist 3) :type)
+  "update")
+
+;; ── diff between versions ──
+(define dvf (content/diff-versions B "post" 1 3))
+(content-test "diff added" (get dvf :added) (list "img" "p"))
+(content-test "diff removed empty" (get dvf :removed) (list))
+(content-test "diff changed empty" (get dvf :changed) (list))
+
+(define dvf2 (content/diff-versions B "post" 3 5))
+(content-test "diff2 removed" (get dvf2 :removed) (list "img"))
+(content-test "diff2 changed" (get dvf2 :changed) (list "p"))
+(content-test "diff2 added empty" (get dvf2 :added) (list))
+
+;; ── direct diff of two materialised docs ──
+(define da (content/at B "post" 2))
+(define db (content/at B "post" 5))
+(content-test
+  "direct diff changed"
+  (get (content/diff da db) :changed)
+  (list "p"))
+(content-test
+  "direct diff no-op"
+  (get (content/diff da da) :changed)
+  (list))
+
+;; ── commit-all batch ──
+(define B2 (persist/open))
+(content/commit-all!
+  B2
+  "doc2"
+  (list (op-insert h nil) (op-insert p "h"))
+  1)
+(content-test "commit-all count" (content/version-count B2 "doc2") 2)
+(content-test
+  "commit-all head"
+  (doc-ids (content/head B2 "doc2"))
+  (list "h" "p"))
+
+;; ── stream isolation ──
+(content-test
+  "separate stream empty"
+  (content/version-count B "doc2")
+  0)
+(content-test
+  "head of empty stream"
+  (doc-ids (content/head B "never"))
+  (list))
+
+;; ── op-log carries non-core block types (callout/media) through replay ──
+(content-bootstrap-callout!)
+(content-bootstrap-media!)
+(define B3 (persist/open))
+(content/commit!
+  B3
+  "rich"
+  (op-insert (mk-callout "co" "note" "hi") nil)
+  1)
+(content/commit!
+  B3
+  "rich"
+  (op-insert (mk-media "v" "video" "/c.mp4") "co")
+  2)
+(content/commit! B3 "rich" (op-update "co" "text" "edited") 3)
+(content-test
+  "op-log rich ids"
+  (doc-ids (content/head B3 "rich"))
+  (list "co" "v"))
+(content-test
+  "op-log callout type"
+  (blk-type (doc-find (content/head B3 "rich") "co"))
+  "callout")
+(content-test
+  "op-log callout update"
+  (str (blk-send (doc-find (content/head B3 "rich") "co") "text"))
+  "edited")
+(content-test
+  "op-log media type"
+  (blk-type (doc-find (content/head B3 "rich") "v"))
+  "media")
+
+;; ── op-log update/delete reach NESTED blocks (tree-wide by id) ──
+(content-bootstrap-section!)
+(define B4 (persist/open))
+(content/commit!
+  B4
+  "nest"
+  (op-insert (mk-section "sec" (list (mk-text "n" "orig"))) nil)
+  1)
+(content/commit! B4 "nest" (op-update "n" "text" "edited") 2)
+(content-test
+  "op-log nested update"
+  (str (blk-send (doc-deep-find (content/head B4 "nest") "n") "text"))
+  "edited")
+(content-test
+  "op-log nested update tree intact"
+  (doc-tree-ids (content/head B4 "nest"))
+  (list "sec" "n"))
+(content/commit! B4 "nest" (op-delete "n") 3)
+(content-test
+  "op-log nested delete"
+  (doc-tree-ids (content/head B4 "nest"))
+  (list "sec"))
+(content-test
+  "op-log nested delete via content/at seq2"
+  (doc-tree-ids (content/at B4 "nest" 2))
+  (list "sec" "n"))
+
+;; ── diff is TREE-WIDE: nested-block add/change/remove are detected, and
+;; section containers never appear in :changed (a top-level-only diff would miss
+;; "n" entirely and instead flag the section). ──
+(define dn01 (content/diff-versions B4 "nest" 0 1))
+(content-test
+  "diff nested added (section + child)"
+  (get dn01 :added)
+  (list "sec" "n"))
+(content-test "diff nested added removed empty" (get dn01 :removed) (list))
+(content-test "diff nested added changed empty" (get dn01 :changed) (list))
+
+(define dn12 (content/diff-versions B4 "nest" 1 2))
+(content-test
+  "diff nested changed child only"
+  (get dn12 :changed)
+  (list "n"))
+(content-test "diff nested changed no add" (get dn12 :added) (list))
+(content-test "diff nested changed no remove" (get dn12 :removed) (list))
+
+(define dn23 (content/diff-versions B4 "nest" 2 3))
+(content-test "diff nested removed child" (get dn23 :removed) (list "n"))
+(content-test "diff nested removed no change" (get dn23 :changed) (list))
+
+(content-test
+  "diff nested no-op"
+  (get (content/diff-versions B4 "nest" 1 1) :changed)
+  (list))

lib/content/tests/summary.sx

@@ -0,0 +1,74 @@
+;; Extension — list-card summary projection.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-text!)
+
+(define
+  d
+  (doc-with-title
+    (doc-append
+      (doc-append
+        (doc-append (doc-empty "post") (mk-heading "h" 1 "Hello"))
+        (mk-text "p" "one two three four"))
+      (mk-image "img" "/cover.png" "cover"))
+    "My Post"))
+
+;; image alt ("cover") is part of the plain-text projection, so it counts.
+(define s (content/summary d))
+(content-test "summary id" (get s :id) "post")
+(content-test "summary title" (get s :title) "My Post")
+(content-test
+  "summary excerpt"
+  (get s :excerpt)
+  "Hello one two three four cover")
+(content-test "summary words" (get s :words) 6)
+(content-test "summary reading" (get s :reading-minutes) 1)
+(content-test "summary cover" (get s :cover) "/cover.png")
+
+;; ── title falls back to id ──
+(content-test
+  "summary title fallback"
+  (get
+    (content/summary (doc-append (doc-empty "x") (mk-text "p" "y")))
+    :title)
+  "x")
+
+;; ── no image → cover nil ──
+(content-test
+  "no cover"
+  (get
+    (content/summary (doc-append (doc-empty "x") (mk-text "p" "y")))
+    :cover)
+  nil)
+(content-test "cover helper nil" (content/cover (doc-empty "e")) nil)
+
+;; ── first image wins as cover ──
+(define
+  d2
+  (doc-append
+    (doc-append (doc-empty "d") (mk-image "i1" "/a.png" "a"))
+    (mk-image "i2" "/b.png" "b")))
+(content-test "first image cover" (content/cover d2) "/a.png")
+
+;; ── empty doc ──
+(define se (content/summary (doc-empty "e")))
+(content-test "empty summary words" (get se :words) 0)
+(content-test "empty summary excerpt" (get se :excerpt) "")
+(content-test "empty summary cover" (get se :cover) nil)
+
+;; ── excerpt truncates long content ──
+(content-test
+  "excerpt truncated"
+  (>
+    (string-length
+      (get
+        (content/summary
+          (doc-append
+            (doc-empty "d")
+            (mk-text
+              "p"
+              "word word word word word word word word word word word word word word word word word word word word word word word word word word word word word word word word word")))
+        :excerpt))
+    100)
+  true)

lib/content/tests/sync.sx

@@ -0,0 +1,74 @@
+;; Phase 4 — external CMS sync via injected adapter. Import/export round-trip.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-render!)
+
+;; ── a Ghost post (external shape) ──
+(define post {:sections (list {:id "h" :text "Hello" :kind "heading" :level 1} {:id "p" :text "World" :kind "paragraph"} {:id "i" :src "/c.png" :alt "cat" :kind "image"} {:id "d" :kind "hr"} {:items (list "a" "b") :id "l" :kind "list" :ordered true}) :title "Hello"})
+
+;; ── import (delegates to adapter) ──
+(define doc (content/import ghost-adapter post "post"))
+(content-test "import doc-id" (doc-id doc) "post")
+(content-test "import ids" (doc-ids doc) (list "h" "p" "i" "d" "l"))
+(content-test
+  "import types"
+  (doc-types doc)
+  (list "heading" "text" "image" "divider" "list"))
+(content-test
+  "import renders"
+  (content/render doc "html")
+  "<h1>Hello</h1><p>World</p><img src=\"/c.png\" alt=\"cat\"><hr><ol><li>a</li><li>b</li></ol>")
+(content-test
+  "import preserves heading level"
+  (blk-send (doc-find doc "h") "level")
+  1)
+(content-test
+  "import preserves list items"
+  (blk-send (doc-find doc "l") "items")
+  (list "a" "b"))
+
+;; ── export (delegates to adapter) ──
+(define out (content/export ghost-adapter doc))
+(content-test
+  "export sections round-trip"
+  (get out :sections)
+  (get post :sections))
+
+;; ── round-trip: export then import yields the same document ──
+(define doc2 (content/round-trip ghost-adapter doc))
+(content-test "round-trip ids" (doc-ids doc2) (doc-ids doc))
+(content-test
+  "round-trip render"
+  (content/render doc2 "html")
+  (content/render doc "html"))
+
+;; ── round-trip the external form: import . export . import == import ──
+(content-test
+  "external round-trip sections"
+  (get
+    (content/export ghost-adapter (content/import ghost-adapter post "post"))
+    :sections)
+  (get post :sections))
+
+;; ── core knows nothing about Ghost: a different (stub) adapter works the same ──
+(define raw-adapter {:export (fn (d) (str (blk-send (doc-find d "only") "text"))) :import (fn (ext doc-id) (doc-new doc-id (list (mk-text "only" ext))))})
+(define rdoc (content/import raw-adapter "just text" "r"))
+(content-test "alt adapter import" (doc-ids rdoc) (list "only"))
+(content-test
+  "alt adapter export"
+  (content/export raw-adapter rdoc)
+  "just text")
+
+;; ── code / quote / embed kinds round-trip ──
+(define post2 {:sections (list {:id "c" :text "(+ 1 2)" :kind "code" :language "sx"} {:cite "Ada" :id "q" :text "to err" :kind "quote"} {:id "e" :provider "vimeo" :kind "embed" :url "https://v/1"})})
+(define d3 (content/import ghost-adapter post2 "p2"))
+(content-test
+  "code/quote/embed types"
+  (doc-types d3)
+  (list "code" "quote" "embed"))
+(content-test
+  "code/quote/embed round-trip"
+  (get (content/export ghost-adapter d3) :sections)
+  (get post2 :sections))

lib/content/tests/table.sx

@@ -0,0 +1,77 @@
+;; Extension — table block.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-text!)
+(content-bootstrap-table!)
+
+(define nl (str "\n"))
+
+(define
+  t
+  (mk-table
+    "t"
+    (list "Name" "Age")
+    (list (list "Ada" "36") (list "Al" "40"))))
+
+;; ── identity ──
+(content-test "table is block" (block? t) true)
+(content-test "table? yes" (table? t) true)
+(content-test "table type" (blk-type t) "table")
+(content-test "table headers" (table-headers t) (list "Name" "Age"))
+(content-test "table rows" (len (table-rows t)) 2)
+
+;; ── html ──
+(content-test
+  "table html"
+  (asHTML t)
+  "<table><thead><tr><th>Name</th><th>Age</th></tr></thead><tbody><tr><td>Ada</td><td>36</td></tr><tr><td>Al</td><td>40</td></tr></tbody></table>")
+(content-test
+  "table html escapes cells"
+  (asHTML (mk-table "t" (list "A<B") (list (list "x&y"))))
+  "<table><thead><tr><th>A&lt;B</th></tr></thead><tbody><tr><td>x&amp;y</td></tr></tbody></table>")
+
+;; ── sx ──
+(content-test
+  "table sx"
+  (asSx t)
+  "(table (thead (tr (th \"Name\")(th \"Age\"))) (tbody (tr (td \"Ada\")(td \"36\"))(tr (td \"Al\")(td \"40\"))))")
+
+;; ── text ──
+(content-test "table text" (asText t) "Name Age Ada 36 Al 40")
+
+;; ── markdown ──
+(content-test
+  "table markdown"
+  (asMarkdown t)
+  (str "| Name | Age |" nl "| --- | --- |" nl "| Ada | 36 |" nl "| Al | 40 |"))
+
+;; ── in a document ──
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "Data"))
+    t))
+(content-test
+  "doc with table html"
+  (asHTML d)
+  "<h1>Data</h1><table><thead><tr><th>Name</th><th>Age</th></tr></thead><tbody><tr><td>Ada</td><td>36</td></tr><tr><td>Al</td><td>40</td></tr></tbody></table>")
+(content-test "doc ids" (doc-ids d) (list "h" "t"))
+
+;; ── empty rows ──
+(content-test
+  "table no rows html"
+  (asHTML (mk-table "t" (list "H") (list)))
+  "<table><thead><tr><th>H</th></tr></thead><tbody></tbody></table>")
+
+;; ── validation ──
+(content-test
+  "valid table"
+  (content/valid? (doc-append (doc-empty "d") t))
+  true)
+(content-test
+  "bad headers flagged"
+  (content/issue-kinds
+    (doc-append (doc-empty "d") (mk-table "t" "nope" (list))))
+  (list "field"))

lib/content/tests/text.sx

@@ -0,0 +1,72 @@
+;; Extension — plain-text render mode + excerpts.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-text!)
+
+;; ── per-block ──
+(content-test
+  "heading text"
+  (asText (mk-heading "h" 2 "Title"))
+  "Title")
+(content-test "paragraph text" (asText (mk-text "p" "Body")) "Body")
+(content-test "code text" (asText (mk-code "c" "sx" "(+ 1 2)")) "(+ 1 2)")
+(content-test "quote text" (asText (mk-quote "q" "Ada" "to err")) "to err")
+(content-test
+  "image -> alt"
+  (asText (mk-image "i" "/c.png" "a cat"))
+  "a cat")
+(content-test
+  "embed -> empty"
+  (asText (mk-embed "e" "https://v" "vimeo"))
+  "")
+(content-test "divider -> empty" (asText (mk-divider "d")) "")
+(content-test
+  "list -> joined"
+  (asText (mk-list "l" false (list "a" "b" "c")))
+  "a, b, c")
+(content-test "empty list -> empty" (asText (mk-list "l" false (list))) "")
+
+;; ── document joins non-empty child texts with a space ──
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append
+        (doc-append (doc-empty "d") (mk-heading "h" 1 "Title"))
+        (mk-text "p" "Hello world"))
+      (mk-divider "dv"))
+    (mk-list "l" true (list "x" "y"))))
+(content-test "doc text skips empties" (asText d) "Title Hello world x, y")
+(content-test "empty doc text" (asText (doc-empty "e")) "")
+
+;; ── via facade ──
+(content-test "render text" (content/render d "text") (asText d))
+(content-test "render text keyword" (content/render d :text) (asText d))
+(content-test "content/text alias" (content/text d) (asText d))
+(content-test "block-text alias" (block-text (mk-text "p" "x")) "x")
+
+;; ── excerpt ──
+(content-test
+  "excerpt under limit"
+  (content/excerpt d 100)
+  "Title Hello world x, y")
+(content-test "excerpt truncates" (content/excerpt d 5) "Title…")
+(content-test
+  "excerpt exact length"
+  (content/excerpt
+    (doc-append (doc-empty "e") (mk-text "p" "12345"))
+    5)
+  "12345")
+(content-test
+  "excerpt one over"
+  (content/excerpt
+    (doc-append (doc-empty "e") (mk-text "p" "123456"))
+    5)
+  "12345…")
+
+;; ── reflects edits ──
+(content-test
+  "text after update"
+  (asText (doc-update d "p" "text" "Changed"))
+  "Title Changed x, y")

lib/content/tests/toc.sx

@@ -0,0 +1,63 @@
+;; Extension — table-of-contents rendering.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+(define nl (str "\n"))
+
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append
+        (doc-append (doc-empty "d") (mk-heading "intro" 1 "Intro"))
+        (mk-text "p" "x"))
+      (mk-heading "bg" 2 "Background"))
+    (mk-section "s" (list (mk-heading "deep" 2 "Details")))))
+
+;; ── markdown TOC (indented by level) ──
+(content-test
+  "toc markdown"
+  (content/toc-markdown d)
+  (str
+    "- [Intro](#intro)"
+    nl
+    "  - [Background](#bg)"
+    nl
+    "  - [Details](#deep)"))
+
+;; ── html TOC (anchor links) ──
+(content-test
+  "toc html"
+  (content/toc-html d)
+  "<ul><li><a href=\"#intro\">Intro</a></li><li><a href=\"#bg\">Background</a></li><li><a href=\"#deep\">Details</a></li></ul>")
+
+;; ── html escapes heading text ──
+(content-test
+  "toc html escapes"
+  (content/toc-html
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "A < B")))
+  "<ul><li><a href=\"#h\">A &lt; B</a></li></ul>")
+
+;; ── empty / no headings ──
+(content-test "toc html empty" (content/toc-html (doc-empty "e")) "")
+(content-test "toc markdown empty" (content/toc-markdown (doc-empty "e")) "")
+(content-test
+  "toc no headings"
+  (content/toc-html (doc-append (doc-empty "d") (mk-text "p" "just text")))
+  "")
+
+;; ── single heading ──
+(content-test
+  "toc single md"
+  (content/toc-markdown
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "Only")))
+  "- [Only](#h)")
+
+;; ── deep level indentation ──
+(content-test
+  "toc deep indent"
+  (content/toc-markdown
+    (doc-append (doc-empty "d") (mk-heading "h" 3 "Deep")))
+  "    - [Deep](#h)")

lib/content/tests/transform.sx

@@ -0,0 +1,90 @@
+;; Extension — tree-wide block transforms.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "Top"))
+    (mk-section
+      "s"
+      (list (mk-text "a" "A") (mk-heading "h2" 2 "Sub")))))
+
+;; ── map-type bumps heading levels everywhere ──
+(define
+  d1
+  (content/map-type
+    d
+    "heading"
+    (fn (b) (blk-set b "level" (+ (blk-get b "level") 1)))))
+(content-test
+  "map-type top heading"
+  (blk-send (doc-deep-find d1 "h") "level")
+  2)
+(content-test
+  "map-type nested heading"
+  (blk-send (doc-deep-find d1 "h2") "level")
+  3)
+(content-test
+  "map-type leaves text"
+  (str (blk-send (doc-deep-find d1 "a") "text"))
+  "A")
+(content-test
+  "map-type immutable"
+  (blk-send (doc-deep-find d "h") "level")
+  1)
+(content-test "map-type preserves tree" (doc-tree-ids d1) (doc-tree-ids d))
+
+;; ── set-field-on rewrites all text blocks ──
+(define d2 (content/set-field-on d "text" "text" "REDACTED"))
+(content-test
+  "set-field nested text"
+  (str (blk-send (doc-deep-find d2 "a") "text"))
+  "REDACTED")
+(content-test
+  "set-field count"
+  (len
+    (filter
+      (fn (b) (= (str (blk-get b "text")) "REDACTED"))
+      (list (doc-deep-find d2 "a"))))
+  1)
+
+;; ── map-blocks with custom predicate ──
+(define
+  d3
+  (content/map-blocks
+    d
+    (fn (b) (= (blk-id b) "h2"))
+    (fn (b) (blk-set b "text" "Changed"))))
+(content-test
+  "map-blocks predicate hit"
+  (str (blk-send (doc-deep-find d3 "h2") "text"))
+  "Changed")
+(content-test
+  "map-blocks predicate miss"
+  (str (blk-send (doc-deep-find d3 "h") "text"))
+  "Top")
+
+;; ── image src rewrite (cdn migration) ──
+(define di (doc-append (doc-empty "d") (mk-image "img" "/old.png" "x")))
+(content-test
+  "image src rewrite"
+  (str
+    (blk-send
+      (doc-find (content/set-field-on di "image" "src" "/cdn/new.png") "img")
+      "src"))
+  "/cdn/new.png")
+
+;; ── no matching blocks → unchanged ──
+(content-test
+  "no match unchanged"
+  (asHTML (content/map-type d "embed" (fn (b) b)))
+  (asHTML d))
+
+;; ── render after transform ──
+(content-test
+  "render after map-type"
+  (asHTML d1)
+  "<h2>Top</h2><section><p>A</p><h3>Sub</h3></section>")

lib/content/tests/tree-edit.sx

@@ -0,0 +1,91 @@
+;; Extension — deep tree editing (update/delete/insert into nested sections).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+;; doc:  top  /  sec[ a, inner[ b ] ]
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-text "top" "T"))
+    (mk-section
+      "sec"
+      (list
+        (mk-text "a" "A")
+        (mk-section "inner" (list (mk-text "b" "B")))))))
+
+;; ── deep-update a nested block ──
+(define d1 (doc-deep-update d "b" "text" "Edited"))
+(content-test
+  "deep-update nested"
+  (str (blk-send (doc-deep-find d1 "b") "text"))
+  "Edited")
+(content-test
+  "deep-update immutable"
+  (str (blk-send (doc-deep-find d "b") "text"))
+  "B")
+(content-test
+  "deep-update top-level"
+  (str
+    (blk-send
+      (doc-deep-find (doc-deep-update d "top" "text" "X") "top")
+      "text"))
+  "X")
+(content-test
+  "deep-update mid-section"
+  (str
+    (blk-send (doc-deep-find (doc-deep-update d "a" "text" "AA") "a") "text"))
+  "AA")
+(content-test
+  "deep-update preserves tree"
+  (doc-tree-ids d1)
+  (doc-tree-ids d))
+
+;; ── deep-replace ──
+(define d2 (doc-deep-replace d "b" (mk-heading "b" 3 "H")))
+(content-test
+  "deep-replace type"
+  (blk-type (doc-deep-find d2 "b"))
+  "heading")
+(content-test
+  "deep-replace render"
+  (asHTML d2)
+  "<p>T</p><section><p>A</p><section><h3>H</h3></section></section>")
+
+;; ── deep-delete ──
+(define d3 (doc-deep-delete d "b"))
+(content-test "deep-delete removes nested" (doc-deep-find d3 "b") nil)
+(content-test
+  "deep-delete tree-ids"
+  (doc-tree-ids d3)
+  (list "top" "sec" "a" "inner"))
+(content-test "deep-delete immutable" (doc-tree-count d) 5)
+(content-test
+  "deep-delete mid-section"
+  (doc-tree-ids (doc-deep-delete d "a"))
+  (list "top" "sec" "inner" "b"))
+(content-test
+  "deep-delete top-level"
+  (doc-tree-ids (doc-deep-delete d "top"))
+  (list "sec" "a" "inner" "b"))
+
+;; ── deep-insert-into a nested section ──
+(define d4 (doc-deep-insert-into d "inner" (mk-text "c" "C")))
+(content-test
+  "insert-into nested"
+  (doc-tree-ids d4)
+  (list "top" "sec" "a" "inner" "b" "c"))
+(content-test
+  "insert-into found"
+  (str (blk-send (doc-deep-find d4 "c") "text"))
+  "C")
+(content-test
+  "insert-into outer section"
+  (doc-tree-ids (doc-deep-insert-into d "sec" (mk-divider "dv")))
+  (list "top" "sec" "a" "inner" "b" "dv"))
+(content-test "insert-into immutable" (doc-tree-count d) 5)
+(content-test
+  "insert-into render"
+  (asHTML d4)
+  "<p>T</p><section><p>A</p><section><p>B</p><p>C</p></section></section>")

lib/content/tests/validate.sx

@@ -0,0 +1,226 @@
+;; Extension — document integrity validation (tree-aware: descends into sections).
+;; (Conformance loads section.sx before this suite.)
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-section!)
+(content-bootstrap-table!)
+
+;; ── a fully valid document ──
+(define
+  good
+  (doc-append
+    (doc-append
+      (doc-append (doc-empty "d") (mk-heading "h" 1 "Title"))
+      (mk-text "p" "Body"))
+    (mk-list "l" true (list "a" "b"))))
+(content-test "valid doc is valid" (content/valid? good) true)
+(content-test "valid doc no issues" (content/validate good) (list))
+
+;; ── bad field types ──
+(content-test
+  "heading bad level"
+  (content/issue-kinds
+    (doc-append (doc-empty "d") (mk-heading "h" "notnum" "T")))
+  (list "field"))
+(content-test
+  "text bad type"
+  (content/issue-kinds
+    (doc-append (doc-empty "d") (mk-text "p" 42)))
+  (list "field"))
+(content-test
+  "image two bad attrs"
+  (len
+    (content/validate
+      (doc-append (doc-empty "d") (mk-image "i" 1 2))))
+  2)
+(content-test
+  "list bad ordered + items"
+  (len
+    (content/validate
+      (doc-append (doc-empty "d") (mk-list "l" "yes" "nope"))))
+  2)
+(content-test
+  "valid image ok"
+  (content/valid?
+    (doc-append (doc-empty "d") (mk-image "i" "/a.png" "alt")))
+  true)
+
+;; ── id checks ──
+(content-test
+  "blank id"
+  (content/issue-kinds (doc-append (doc-empty "d") (mk-text "" "x")))
+  (list "id"))
+(content-test
+  "nil id"
+  (content/issue-kinds
+    (doc-append (doc-empty "d") (blk-set (mk-text "x" "y") "id" nil)))
+  (list "id"))
+
+;; ── duplicate ids ──
+(define
+  dup
+  (doc-append
+    (doc-append (doc-empty "d") (mk-text "x" "a"))
+    (mk-text "x" "b")))
+(content-test
+  "duplicate id detected"
+  (content/issue-kinds dup)
+  (list "duplicate"))
+(content-test
+  "duplicate reported once"
+  (len
+    (filter (fn (i) (= (get i :kind) "duplicate")) (content/validate dup)))
+  1)
+(content-test "duplicate not valid" (content/valid? dup) false)
+
+;; ── unknown block type (raw base instance) ──
+(define raw (st-iv-set! (st-make-instance "CtBlock") "id" "z"))
+(content-test
+  "unknown type flagged"
+  (content/issue-kinds (doc-append (doc-empty "d") raw))
+  (list "type"))
+
+;; ── issue carries id + detail ──
+(define
+  iss
+  (first
+    (content/validate
+      (doc-append (doc-empty "d") (mk-text "bad" 9)))))
+(content-test "issue has id" (get iss :id) "bad")
+(content-test "issue has detail" (string? (get iss :detail)) true)
+
+;; ── multiple issues across blocks accumulate ──
+(define
+  messy
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" "x" "ok"))
+    (mk-text "" 5)))
+(content-test
+  "issues accumulate"
+  (> (len (content/validate messy)) 2)
+  true)
+
+;; ── all block types valid when well-formed ──
+(define
+  allgood
+  (doc-append
+    (doc-append
+      (doc-append
+        (doc-append
+          (doc-append
+            (doc-append (doc-empty "d") (mk-code "c" "sx" "(+ 1 2)"))
+            (mk-quote "q" "Ada" "to err"))
+          (mk-embed "e" "https://v" "vimeo"))
+        (mk-divider "dv"))
+      (mk-heading "hh" 2 "H"))
+    (mk-text "tt" "T")))
+(content-test "all well-formed types valid" (content/valid? allgood) true)
+
+;; ── tree-aware: descends into sections ──
+(define
+  nested
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "s"
+      (list (mk-heading "nh" 1 "H") (mk-text "np" "ok")))))
+(content-test "valid nested section" (content/valid? nested) true)
+
+(define
+  nested-bad
+  (doc-append
+    (doc-empty "d")
+    (mk-section "s" (list (mk-heading "nh" "notnum" "H")))))
+(content-test
+  "nested bad field detected"
+  (content/issue-kinds nested-bad)
+  (list "field"))
+
+;; valid section block itself
+(content-test
+  "section valid"
+  (content/valid? (doc-append (doc-empty "d") (mk-section "s" (list))))
+  true)
+(content-test
+  "section bad children"
+  (content/issue-kinds
+    (doc-append
+      (doc-empty "d")
+      (st-iv-set! (mk-section "s" (list)) "children" "nope")))
+  (list "field"))
+
+;; duplicate id across a section boundary (top-level id == nested id)
+(define
+  dup-tree
+  (doc-append
+    (doc-append (doc-empty "d") (mk-text "x" "top"))
+    (mk-section "s" (list (mk-text "x" "nested")))))
+(content-test
+  "tree-wide duplicate detected"
+  (len
+    (filter
+      (fn (i) (= (get i :kind) "duplicate"))
+      (content/validate dup-tree)))
+  1)
+(content-test "tree dup not valid" (content/valid? dup-tree) false)
+
+;; ── collection blocks vetted ELEMENT-DEEP (items/cells must be strings) ──
+;; A list whose items field is a list but holds a non-string would pass the old
+;; "is a list" check yet crash asText/render — now caught.
+(content-test
+  "list non-string item flagged"
+  (content/issue-kinds
+    (doc-append (doc-empty "d") (mk-list "l" true (list "a" 5))))
+  (list "field"))
+(content-test
+  "list all-string items valid"
+  (content/valid?
+    (doc-append (doc-empty "d") (mk-list "l" false (list "a" "b" "c"))))
+  true)
+(content-test
+  "list empty items valid"
+  (content/valid? (doc-append (doc-empty "d") (mk-list "l" true (list))))
+  true)
+;; a malformed-list block reports exactly one element issue (not the is-a-list one)
+(content-test
+  "list non-string item single issue"
+  (len
+    (content/validate
+      (doc-append
+        (doc-empty "d")
+        (mk-list "l" true (list 1 2)))))
+  1)
+
+(content-test
+  "valid table ok"
+  (content/valid?
+    (doc-append
+      (doc-empty "d")
+      (mk-table "t" (list "H1" "H2") (list (list "a" "b") (list "c" "d")))))
+  true)
+(content-test
+  "table empty rows valid"
+  (content/valid?
+    (doc-append (doc-empty "d") (mk-table "t" (list "H") (list))))
+  true)
+(content-test
+  "table non-list row flagged"
+  (content/issue-kinds
+    (doc-append (doc-empty "d") (mk-table "t" (list "H") (list "notarow"))))
+  (list "field"))
+(content-test
+  "table non-string cell flagged"
+  (content/issue-kinds
+    (doc-append
+      (doc-empty "d")
+      (mk-table "t" (list "H") (list (list "ok") (list 9)))))
+  (list "field"))
+(content-test
+  "table non-string header flagged"
+  (content/issue-kinds
+    (doc-append
+      (doc-empty "d")
+      (mk-table "t" (list "H" 2) (list (list "a" "b")))))
+  (list "field"))

lib/content/tests/wire.sx

@@ -0,0 +1,63 @@
+;; Extension — on-the-wire serialization (to-wire / from-wire).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-text!)
+(content-bootstrap-section!)
+(content-bootstrap-table!)
+
+(define
+  d
+  (doc-with-meta
+    (doc-append
+      (doc-append (doc-empty "post") (mk-heading "h" 1 "Title"))
+      (mk-text "p" "Body text"))
+    {:title "T" :tags (list "x" "y")}))
+
+;; ── to-wire produces a string ──
+(content-test "to-wire is string" (string? (content/to-wire d)) true)
+
+;; ── parse(to-wire) == data form ──
+(content-test
+  "wire parses to data"
+  (parse (content/to-wire d))
+  (content/to-data d))
+
+;; ── round-trip preserves everything ──
+(define rt (content/wire-round-trip d))
+(content-test "rt id" (doc-id rt) "post")
+(content-test "rt title" (doc-title rt) "T")
+(content-test "rt tags" (doc-tags rt) (list "x" "y"))
+(content-test "rt ids" (doc-ids rt) (list "h" "p"))
+(content-test "rt render" (asHTML rt) (asHTML d))
+
+;; ── nested + table survive the wire ──
+(define
+  dn
+  (doc-append
+    (doc-append
+      (doc-empty "d")
+      (mk-section "s" (list (mk-text "a" "deep"))))
+    (mk-table "t" (list "A") (list (list "1")))))
+(content-test
+  "wire nested render"
+  (asHTML (content/wire-round-trip dn))
+  (asHTML dn))
+(content-test
+  "wire nested tree-ids"
+  (doc-tree-ids (content/wire-round-trip dn))
+  (doc-tree-ids dn))
+
+;; ── empty doc ──
+(content-test
+  "wire empty"
+  (doc-ids (content/from-wire (content/to-wire (doc-empty "e"))))
+  (list))
+
+;; ── from-wire of an externally-built wire string ──
+(content-test
+  "from-wire external"
+  (asHTML
+    (content/from-wire
+      "{:id \"x\" :blocks ({:id \"h\" :type \"heading\" :fields {:level 2 :text \"Hi\"}})}"))
+  "<h2>Hi</h2>")

lib/content/text.sx

@@ -0,0 +1,46 @@
+;; content-on-sx — plain-text render mode + excerpts.
+;;
+;; A fourth boundary format via polymorphic dispatch: blocks answer asText,
+;; stripping all markup. Useful for search indexing, meta descriptions and
+;; previews. The document joins non-empty child texts with a single space.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx.
+
+(define
+  content-bootstrap-text!
+  (fn
+    ()
+    (begin
+      (ct-def-method! "CtHeading" "asText" "asText ^ text")
+      (ct-def-method! "CtText" "asText" "asText ^ text")
+      (ct-def-method! "CtCode" "asText" "asText ^ text")
+      (ct-def-method! "CtQuote" "asText" "asText ^ text")
+      (ct-def-method! "CtImage" "asText" "asText ^ alt")
+      (ct-def-method! "CtEmbed" "asText" "asText ^ ''")
+      (ct-def-method! "CtDivider" "asText" "asText ^ ''")
+      (ct-def-method!
+        "CtList"
+        "asText"
+        "asText ^ (items inject: '' into: [:a :x | (a = '' ifTrue: [x] ifFalse: [a , ', ' , x])])")
+      (ct-def-method!
+        "CtDoc"
+        "asText"
+        "asText ^ (blocks inject: '' into: [:a :b | (b asText = '') ifTrue: [a] ifFalse: [(a = '' ifTrue: [b asText] ifFalse: [a , ' ' , b asText])]])")
+      true)))
+
+;; ── SX boundary ──
+(define asText (fn (node) (str (st-send node "asText" (list)))))
+(define content/text asText)
+(define block-text asText)
+
+;; excerpt: first n chars of the plain text, with an ellipsis if truncated.
+(define
+  content/excerpt
+  (fn
+    (doc n)
+    (let
+      ((t (asText doc)))
+      (if
+        (<= (string-length t) n)
+        t
+        (str (substring t 0 n) "…")))))

lib/content/toc.sx

@@ -0,0 +1,68 @@
+;; content-on-sx — table-of-contents rendering.
+;;
+;; Turns content/headings into a user-facing TOC: a Markdown bullet list indented
+;; by heading level, and an HTML <ul> of anchor links (#id). The blog page links
+;; these to heading anchors.
+;;
+;; Requires (loaded by harness): query.sx (content/headings), render.sx
+;; (htmlEscaped).
+
+(define toc-nl (str "\n"))
+(define
+  toc-join
+  (fn
+    (sep parts)
+    (cond
+      ((= (len parts) 0) "")
+      ((= (len parts) 1) (first parts))
+      (else (str (first parts) sep (toc-join sep (rest parts)))))))
+
+(define
+  toc-indent
+  (fn
+    (n)
+    (if (<= n 0) "" (str "  " (toc-indent (- n 1))))))
+(define toc-esc (fn (s) (str (st-send s "htmlEscaped" (list)))))
+
+(define
+  content/toc-markdown
+  (fn
+    (doc)
+    (toc-join
+      toc-nl
+      (map
+        (fn
+          (h)
+          (str
+            (toc-indent (- (get h :level) 1))
+            "- ["
+            (get h :text)
+            "](#"
+            (get h :id)
+            ")"))
+        (content/headings doc)))))
+
+(define
+  content/toc-html
+  (fn
+    (doc)
+    (let
+      ((hs (content/headings doc)))
+      (if
+        (= (len hs) 0)
+        ""
+        (str
+          "<ul>"
+          (toc-join
+            ""
+            (map
+              (fn
+                (h)
+                (str
+                  "<li><a href=\"#"
+                  (get h :id)
+                  "\">"
+                  (toc-esc (get h :text))
+                  "</a></li>"))
+              hs))
+          "</ul>")))))

lib/content/transform.sx

@@ -0,0 +1,52 @@
+;; content-on-sx — tree-wide block transforms.
+;;
+;; The write counterpart to query: apply a function to every matching block
+;; across the tree (descending into sections), returning a new document. For
+;; bulk edits — rewrite image srcs, bump heading levels, sanitise text. Tree
+;; detection/rebuild is inline (class + st-iv-get/set!) so this needs no
+;; section.sx. Immutable.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx.
+
+(define
+  xf-section?
+  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
+
+(define
+  block-tree-transform
+  (fn
+    (blocks pred f)
+    (map
+      (fn
+        (b)
+        (let
+          ((nb (if (pred b) (f b) b)))
+          (if
+            (xf-section? nb)
+            (let
+              ((ch (st-iv-get nb "children")))
+              (if
+                (list? ch)
+                (st-iv-set! nb "children" (block-tree-transform ch pred f))
+                nb))
+            nb)))
+      blocks)))
+
+(define
+  content/map-blocks
+  (fn
+    (doc pred f)
+    (doc-with-blocks doc (block-tree-transform (doc-blocks doc) pred f))))
+
+(define
+  content/map-type
+  (fn
+    (doc type f)
+    (content/map-blocks doc (fn (b) (= (blk-type b) type)) f)))
+
+;; convenience: set a field on every block of a type.
+(define
+  content/set-field-on
+  (fn
+    (doc type field value)
+    (content/map-type doc type (fn (b) (blk-set b field value)))))

lib/content/tree-edit.sx

@@ -0,0 +1,96 @@
+;; content-on-sx — deep tree editing.
+;;
+;; Mutate blocks anywhere in the nested tree (descending into CtSection children),
+;; complementing the top-level doc ops and the deep-find read path. All return
+;; new documents (immutable).
+;;
+;; Requires (loaded by harness): doc.sx, section.sx (section? / section-children /
+;; section-with-children / section-append).
+
+;; map f over every block in the tree, replacing the one whose id matches.
+(define
+  block-tree-update
+  (fn
+    (blocks id f)
+    (map
+      (fn
+        (b)
+        (if
+          (= (blk-id b) id)
+          (f b)
+          (if
+            (section? b)
+            (section-with-children
+              b
+              (block-tree-update (section-children b) id f))
+            b)))
+      blocks)))
+
+;; remove the block with id from anywhere in the tree.
+(define
+  block-tree-delete
+  (fn
+    (blocks id)
+    (map
+      (fn
+        (b)
+        (if
+          (section? b)
+          (section-with-children
+            b
+            (block-tree-delete (section-children b) id))
+          b))
+      (filter (fn (b) (if (= (blk-id b) id) false true)) blocks))))
+
+;; append a block into the children of the section with section-id.
+(define
+  block-tree-insert-into
+  (fn
+    (blocks section-id block)
+    (map
+      (fn
+        (b)
+        (if
+          (section? b)
+          (if
+            (= (blk-id b) section-id)
+            (section-append b block)
+            (section-with-children
+              b
+              (block-tree-insert-into (section-children b) section-id block)))
+          b))
+      blocks)))
+
+;; ── document-level deep ops ──
+(define
+  doc-deep-update
+  (fn
+    (doc id field value)
+    (doc-with-blocks
+      doc
+      (block-tree-update
+        (doc-blocks doc)
+        id
+        (fn (b) (blk-set b field value))))))
+
+(define
+  doc-deep-replace
+  (fn
+    (doc id newblock)
+    (doc-with-blocks
+      doc
+      (block-tree-update (doc-blocks doc) id (fn (b) newblock)))))
+
+(define
+  doc-deep-delete
+  (fn
+    (doc id)
+    (doc-with-blocks doc (block-tree-delete (doc-blocks doc) id))))
+
+(define
+  doc-deep-insert-into
+  (fn
+    (doc section-id block)
+    (doc-with-blocks
+      doc
+      (block-tree-insert-into (doc-blocks doc) section-id block))))

lib/content/validate.sx

@@ -0,0 +1,258 @@
+;; content-on-sx — document integrity validation.
+;;
+;; Guards imports, edits and federated input: walks the whole block TREE (into
+;; nested sections) checking each block's id and required fields/types, plus
+;; tree-wide duplicate ids. Returns issue dicts {:id :kind :detail}; empty = ok.
+;; Tree detection is inline (class + st-iv-get) so this file needs no section.sx.
+;; Dispatch on block type is a validation-boundary concern, not core behaviour.
+;;
+;; Collection blocks are vetted element-deep: list items must all be strings and
+;; table rows must all be lists of strings — exactly what render/asText/
+;; find-replace/search assume — so malformed nested collections are caught at the
+;; boundary instead of crashing the render layer downstream.
+;;
+;; Requires (loaded by harness): block.sx, doc.sx.
+
+(define ct-issue (fn (id kind detail) {:id id :detail detail :kind kind}))
+
+(define
+  ct-flatmap
+  (fn
+    (f xs)
+    (if
+      (= (len xs) 0)
+      (list)
+      (append (f (first xs)) (ct-flatmap f (rest xs))))))
+
+(define ct-count-in (fn (x xs) (len (filter (fn (y) (= y x)) xs))))
+
+;; dedup, order-preserving (keep first occurrence)
+(define
+  ct-uniq-loop
+  (fn
+    (xs seen)
+    (if
+      (= (len xs) 0)
+      (reverse seen)
+      (if
+        (> (ct-count-in (first xs) seen) 0)
+        (ct-uniq-loop (rest xs) seen)
+        (ct-uniq-loop (rest xs) (cons (first xs) seen))))))
+
+(define ct-uniq (fn (xs) (ct-uniq-loop xs (list))))
+
+;; every element a string? / every row a list of strings? (for collection blocks)
+(define
+  ct-all-str?
+  (fn
+    (xs)
+    (if
+      (= (len xs) 0)
+      true
+      (if (string? (first xs)) (ct-all-str? (rest xs)) false))))
+
+(define
+  ct-all-rows?
+  (fn
+    (rows)
+    (if
+      (= (len rows) 0)
+      true
+      (if
+        (if (list? (first rows)) (ct-all-str? (first rows)) false)
+        (ct-all-rows? (rest rows))
+        false))))
+
+;; ── tree flatten (descends into CtSection children; guards malformed children) ──
+(define
+  ct-section-block?
+  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
+(define
+  ct-tree-blocks
+  (fn
+    (blocks)
+    (if
+      (= (len blocks) 0)
+      (list)
+      (let
+        ((b (first blocks)))
+        (append
+          (cons
+            b
+            (if
+              (ct-section-block? b)
+              (let
+                ((ch (st-iv-get b "children")))
+                (if (list? ch) (ct-tree-blocks ch) (list)))
+              (list)))
+          (ct-tree-blocks (rest blocks)))))))
+
+;; ── id checks ──
+(define
+  content/-id-issues
+  (fn
+    (b)
+    (let
+      ((id (blk-id b)))
+      (if
+        (and (string? id) (> (len id) 0))
+        (list)
+        (list (ct-issue id "id" "block id must be a non-empty string"))))))
+
+(define
+  ct-field-issue
+  (fn (id ok? what) (if ok? (list) (list (ct-issue id "field" what)))))
+
+;; ── per-type field checks ──
+(define
+  content/-field-issues
+  (fn
+    (b)
+    (let
+      ((t (blk-type b)) (id (blk-id b)))
+      (cond
+        ((= t "heading")
+          (append
+            (ct-field-issue
+              id
+              (number? (blk-get b "level"))
+              "heading level must be a number")
+            (ct-field-issue
+              id
+              (string? (blk-get b "text"))
+              "heading text must be a string")))
+        ((= t "text")
+          (ct-field-issue
+            id
+            (string? (blk-get b "text"))
+            "text must be a string"))
+        ((= t "code")
+          (append
+            (ct-field-issue
+              id
+              (string? (blk-get b "language"))
+              "code language must be a string")
+            (ct-field-issue
+              id
+              (string? (blk-get b "text"))
+              "code text must be a string")))
+        ((= t "quote")
+          (ct-field-issue
+            id
+            (string? (blk-get b "text"))
+            "quote text must be a string"))
+        ((= t "image")
+          (append
+            (ct-field-issue
+              id
+              (string? (blk-get b "src"))
+              "image src must be a string")
+            (ct-field-issue
+              id
+              (string? (blk-get b "alt"))
+              "image alt must be a string")))
+        ((= t "embed")
+          (append
+            (ct-field-issue
+              id
+              (string? (blk-get b "url"))
+              "embed url must be a string")
+            (ct-field-issue
+              id
+              (string? (blk-get b "provider"))
+              "embed provider must be a string")))
+        ((= t "divider") (list))
+        ((= t "list")
+          (let
+            ((items (blk-get b "items")))
+            (append
+              (ct-field-issue
+                id
+                (boolean? (blk-get b "ordered"))
+                "list ordered must be a boolean")
+              (append
+                (ct-field-issue id (list? items) "list items must be a list")
+                (ct-field-issue
+                  id
+                  (if (list? items) (ct-all-str? items) true)
+                  "list items must all be strings")))))
+        ((= t "section")
+          (ct-field-issue
+            id
+            (list? (blk-get b "children"))
+            "section children must be a list"))
+        ((= t "table")
+          (let
+            ((headers (blk-get b "headers")) (rows (blk-get b "rows")))
+            (append
+              (append
+                (ct-field-issue
+                  id
+                  (list? headers)
+                  "table headers must be a list")
+                (ct-field-issue
+                  id
+                  (if (list? headers) (ct-all-str? headers) true)
+                  "table headers must all be strings"))
+              (append
+                (ct-field-issue id (list? rows) "table rows must be a list")
+                (ct-field-issue
+                  id
+                  (if (list? rows) (ct-all-rows? rows) true)
+                  "table rows must all be lists of strings")))))
+        ((= t "callout")
+          (append
+            (ct-field-issue
+              id
+              (string? (blk-get b "kind"))
+              "callout kind must be a string")
+            (ct-field-issue
+              id
+              (string? (blk-get b "text"))
+              "callout text must be a string")))
+        ((= t "media")
+          (append
+            (ct-field-issue
+              id
+              (if
+                (= (blk-get b "kind") "video")
+                true
+                (= (blk-get b "kind") "audio"))
+              "media kind must be video or audio")
+            (ct-field-issue
+              id
+              (string? (blk-get b "src"))
+              "media src must be a string")))
+        (else (list (ct-issue id "type" (str "unknown block type: " t))))))))
+
+(define
+  content/-block-issues
+  (fn (b) (append (content/-id-issues b) (content/-field-issues b))))
+
+;; ── duplicate ids across the whole tree ──
+(define
+  content/-dup-issues
+  (fn
+    (ids)
+    (map
+      (fn (id) (ct-issue id "duplicate" (str "duplicate block id: " id)))
+      (ct-uniq (filter (fn (id) (> (ct-count-in id ids) 1)) ids)))))
+
+;; ── public ──
+(define
+  content/validate
+  (fn
+    (doc)
+    (let
+      ((all (ct-tree-blocks (doc-blocks doc))))
+      (append
+        (content/-dup-issues (map (fn (b) (blk-id b)) all))
+        (ct-flatmap content/-block-issues all)))))
+
+(define
+  content/valid?
+  (fn (doc) (= (len (content/validate doc)) 0)))
+
+(define
+  content/issue-kinds
+  (fn (doc) (map (fn (i) (get i :kind)) (content/validate doc))))

lib/content/wire.sx

@@ -0,0 +1,14 @@
+;; content-on-sx — on-the-wire serialization.
+;;
+;; content/to-wire serialises a document to a transmittable SX-text string (via
+;; the data form + the SX serializer); content/from-wire parses it back into a
+;; live document. This is the format to persist a whole document or send it over
+;; HTTP / federation, distinct from the per-op persist log.
+;;
+;; Requires (loaded by harness): data.sx (content/to-data / content/from-data).
+
+(define content/to-wire (fn (doc) (serialize (content/to-data doc))))
+(define content/from-wire (fn (s) (content/from-data (parse s))))
+(define
+  content/wire-round-trip
+  (fn (doc) (content/from-wire (content/to-wire doc))))

lib/identity/audit.sx

@@ -1,27 +0,0 @@
-;; identity/audit.sx — the grant audit ledger.
-;;
-;; Every transition that changes a grant — issue, refresh, revoke (and,
-;; wired from oauth, consent) — appends an immutable event to this
-;; append-only process. The ledger is queryable by subject, which is what
-;; `(identity/audit subject)` answers. This is the in-memory realisation
-;; of the event stream; a persist-backed stream is a later substrate
-;; concern (Erlang↔persist bridge), kept out of scope here per the loop's
-;; \"in-memory log until persist lands\" allowance — the queryable
-;; semantics are identical.
-;;
-;; Events are {Seq, Subject, Action}; Seq is a monotonic sequence number.
-;; Reads return chronological (oldest-first) order:
-;;
-;;   record(A, Subject, Action)  -> ok       (one-way; FIFO-ordered)
-;;   audit(A, Subject)           -> [{Seq, Subject, Action}, ...]
-;;   actions(A, Subject)         -> [Action, ...]
-;;   count(A, Subject)           -> N
-;;   all(A)                      -> [{Seq, Subject, Action}, ...]
-
-(define
-  identity-audit-source
-  "-module(identity_audit).\n\n   start() ->\n     spawn(fun () -> loop([], 0) end).\n\n   record(A, Subject, Action) ->\n     A ! {event, Subject, Action},\n     ok.\n\n   audit(A, Subject) ->\n     A ! {audit, Subject, self()},\n     receive {audit_reply, R} -> R end.\n\n   actions(A, Subject) ->\n     A ! {actions, Subject, self()},\n     receive {audit_reply, R} -> R end.\n\n   count(A, Subject) ->\n     A ! {count, Subject, self()},\n     receive {audit_reply, R} -> R end.\n\n   all(A) ->\n     A ! {all, self()},\n     receive {audit_reply, R} -> R end.\n\n   loop(Events, Seq) ->\n     receive\n       {event, Subject, Action} ->\n         loop([{Seq, Subject, Action} | Events], Seq + 1);\n       {audit, Subject, From} ->\n         From ! {audit_reply, collect(Subject, Events, [])},\n         loop(Events, Seq);\n       {actions, Subject, From} ->\n         From ! {audit_reply, action_list(Subject, Events, [])},\n         loop(Events, Seq);\n       {count, Subject, From} ->\n         From ! {audit_reply, count_subj(Subject, Events, 0)},\n         loop(Events, Seq);\n       {all, From} ->\n         From ! {audit_reply, reverse(Events, [])},\n         loop(Events, Seq);\n       {stop, From} ->\n         From ! {audit_reply, ok}\n     end.\n\n   collect(_, [], Acc) -> Acc;\n   collect(Subject, [{Seq, S, A} | Rest], Acc) ->\n     case S =:= Subject of\n       true -> collect(Subject, Rest, [{Seq, S, A} | Acc]);\n       false -> collect(Subject, Rest, Acc)\n     end.\n\n   action_list(_, [], Acc) -> Acc;\n   action_list(Subject, [{_, S, A} | Rest], Acc) ->\n     case S =:= Subject of\n       true -> action_list(Subject, Rest, [A | Acc]);\n       false -> action_list(Subject, Rest, Acc)\n     end.\n\n   count_subj(_, [], N) -> N;\n   count_subj(Subject, [{_, S, _} | Rest], N) ->\n     case S =:= Subject of\n       true -> count_subj(Subject, Rest, N + 1);\n       false -> count_subj(Subject, Rest, N)\n     end.\n\n   reverse([], Acc) -> Acc;\n   reverse([H | T], Acc) -> reverse(T, [H | Acc]).")
-
-(define
-  identity-load-audit!
-  (fn () (erlang-load-module identity-audit-source)))

lib/identity/cache.sx

@@ -1,29 +0,0 @@
-;; identity/cache.sx — a delegated grant-verification cache, mirroring the
-;; Redis-cache pattern apps use in front of grant verification.
-;;
-;; The cache is a process wrapping a token registry. introspect() is
-;; memoised; issue/issue_grant/refresh/revoke pass through. The danger
-;; with any cache is staleness: a revoked token must NOT keep reading
-;; valid out of the cache, not even for a millisecond (the loop's hard
-;; rule). We get that for free with GENERATION invalidation:
-;;
-;;   - each cache entry records the generation it was written at;
-;;   - a hit requires entry.generation == current generation;
-;;   - any state-changing op that can invalidate an existing token
-;;     (revoke — which cascades to a grant; refresh — whose reuse cascades)
-;;     bumps the generation.
-;;
-;; So a single revoke instantly invalidates every cached positive: the
-;; next introspect is a miss and re-validates against the live registry,
-;; which returns {inactive}. Revocation stays real; the cache only ever
-;; accelerates the steady state, never overrides a revocation.
-;;
-;; stats() -> {Hits, Misses} so callers can see the cache is live.
-
-(define
-  identity-cache-source
-  "-module(identity_grant_cache).\n\n   start() ->\n     spawn(fun () ->\n       Reg = identity_tokens:start(),\n       loop(Reg, 1, [], 0, 0)\n     end).\n\n   issue(C, Subject, Client, Scope) ->\n     C ! {issue, Subject, Client, Scope, self()},\n     receive {cache_reply, R} -> R end.\n\n   issue_grant(C, Subject, Client, Scope) ->\n     C ! {issue_grant, Subject, Client, Scope, self()},\n     receive {cache_reply, R} -> R end.\n\n   refresh(C, RefreshTok) ->\n     C ! {refresh, RefreshTok, self()},\n     receive {cache_reply, R} -> R end.\n\n   introspect(C, Token) ->\n     C ! {introspect, Token, self()},\n     receive {cache_reply, R} -> R end.\n\n   revoke(C, Token) ->\n     C ! {revoke, Token, self()},\n     receive {cache_reply, R} -> R end.\n\n   stats(C) ->\n     C ! {stats, self()},\n     receive {cache_reply, R} -> R end.\n\n   loop(Reg, Gen, Entries, Hits, Misses) ->\n     receive\n       {introspect, Tok, From} ->\n         case lookup_fresh(Tok, Gen, Entries) of\n           {hit, Result} ->\n             From ! {cache_reply, Result},\n             loop(Reg, Gen, Entries, Hits + 1, Misses);\n           miss ->\n             Result = identity_tokens:introspect(Reg, Tok),\n             From ! {cache_reply, Result},\n             loop(Reg, Gen, put_entry(Tok, Result, Gen, Entries), Hits, Misses + 1)\n         end;\n       {issue, Subject, Client, Scope, From} ->\n         From ! {cache_reply, identity_tokens:issue(Reg, Subject, Client, Scope)},\n         loop(Reg, Gen, Entries, Hits, Misses);\n       {issue_grant, Subject, Client, Scope, From} ->\n         From ! {cache_reply, identity_tokens:issue_grant(Reg, Subject, Client, Scope)},\n         loop(Reg, Gen, Entries, Hits, Misses);\n       {refresh, RTok, From} ->\n         From ! {cache_reply, identity_tokens:refresh(Reg, RTok)},\n         loop(Reg, Gen + 1, Entries, Hits, Misses);\n       {revoke, Tok, From} ->\n         identity_tokens:revoke(Reg, Tok),\n         From ! {cache_reply, ok},\n         loop(Reg, Gen + 1, Entries, Hits, Misses);\n       {stats, From} ->\n         From ! {cache_reply, {Hits, Misses}},\n         loop(Reg, Gen, Entries, Hits, Misses)\n     end.\n\n   lookup_fresh(_, _, []) -> miss;\n   lookup_fresh(Tok, Gen, [{T, {Result, G}} | Rest]) ->\n     case T =:= Tok of\n       true ->\n         case G =:= Gen of\n           true -> {hit, Result};\n           false -> miss\n         end;\n       false -> lookup_fresh(Tok, Gen, Rest)\n     end.\n\n   put_entry(Tok, Result, Gen, Entries) ->\n     [{Tok, {Result, Gen}} | remove(Tok, Entries)].\n\n   remove(_, []) -> [];\n   remove(Tok, [{T, V} | Rest]) ->\n     case T =:= Tok of\n       true -> remove(Tok, Rest);\n       false -> [{T, V} | remove(Tok, Rest)]\n     end.")
-
-(define
-  identity-load-cache!
-  (fn () (erlang-load-module identity-cache-source)))

lib/identity/clients.sx

@@ -1,28 +0,0 @@
-;; identity/clients.sx — the OAuth client registry (RFC 6749 §2).
-;;
-;; A client is registered with a type, a secret, and its allow-listed
-;; redirect_uris:
-;;
-;;   public        — cannot keep a secret (SPAs, native apps, §2.1);
-;;                   identified but not authenticated.
-;;   confidential  — can authenticate; MUST present its secret at the token
-;;                   endpoint (§3.2.1, §4.1.3). A wrong secret is
-;;                   invalid_client — never a soft pass.
-;;
-;; Redirect URIs must be pre-registered (§3.1.2.2 + OAuth Security BCP):
-;; valid_redirect/3 is the exact-match check the authorize/exchange steps
-;; consult so an attacker cannot redirect the code to an unregistered URI.
-;;
-;;   register(C, ClientId, Type, Secret, RedirectUris) -> ok | {error, exists}
-;;   lookup(C, ClientId)            -> {ok, Type, RedirectUris} | {error, unknown_client}
-;;   authenticate(C, ClientId, Sec) -> {ok, public} | {ok, confidential}
-;;                                   | {error, invalid_client} | {error, unknown_client}
-;;   valid_redirect(C, ClientId, U) -> true | false
-
-(define
-  identity-clients-source
-  "-module(identity_clients).\n\n   start() ->\n     spawn(fun () -> loop([]) end).\n\n   register(C, ClientId, Type, Secret, RedirectUris) ->\n     C ! {register, ClientId, Type, Secret, RedirectUris, self()},\n     receive {client_reply, R} -> R end.\n\n   lookup(C, ClientId) ->\n     C ! {lookup, ClientId, self()},\n     receive {client_reply, R} -> R end.\n\n   authenticate(C, ClientId, Secret) ->\n     C ! {authenticate, ClientId, Secret, self()},\n     receive {client_reply, R} -> R end.\n\n   valid_redirect(C, ClientId, Uri) ->\n     C ! {valid_redirect, ClientId, Uri, self()},\n     receive {client_reply, R} -> R end.\n\n   loop(Clients) ->\n     receive\n       {register, ClientId, Type, Secret, RedirectUris, From} ->\n         case find(ClientId, Clients) of\n           {ok, _} ->\n             From ! {client_reply, {error, exists}},\n             loop(Clients);\n           none ->\n             From ! {client_reply, ok},\n             loop([{ClientId, {Type, Secret, RedirectUris}} | Clients])\n         end;\n       {lookup, ClientId, From} ->\n         case find(ClientId, Clients) of\n           none -> From ! {client_reply, {error, unknown_client}};\n           {ok, {Type, _, Uris}} -> From ! {client_reply, {ok, Type, Uris}}\n         end,\n         loop(Clients);\n       {authenticate, ClientId, Secret, From} ->\n         case find(ClientId, Clients) of\n           none ->\n             From ! {client_reply, {error, unknown_client}};\n           {ok, {public, _, _}} ->\n             From ! {client_reply, {ok, public}};\n           {ok, {confidential, S, _}} ->\n             case S =:= Secret of\n               true -> From ! {client_reply, {ok, confidential}};\n               false -> From ! {client_reply, {error, invalid_client}}\n             end\n         end,\n         loop(Clients);\n       {valid_redirect, ClientId, Uri, From} ->\n         case find(ClientId, Clients) of\n           none -> From ! {client_reply, false};\n           {ok, {_, _, Uris}} -> From ! {client_reply, member(Uri, Uris)}\n         end,\n         loop(Clients);\n       {stop, From} ->\n         From ! {client_reply, ok}\n     end.\n\n   member(_, []) -> false;\n   member(X, [Y | Rest]) ->\n     case X =:= Y of\n       true -> true;\n       false -> member(X, Rest)\n     end.\n\n   find(_, []) -> none;\n   find(Key, [{K, V} | Rest]) ->\n     case K =:= Key of\n       true -> {ok, V};\n       false -> find(Key, Rest)\n     end.")
-
-(define
-  identity-load-clients!
-  (fn () (erlang-load-module identity-clients-source)))

lib/identity/conformance.sh

@@ -1,215 +0,0 @@
-#!/usr/bin/env bash
-# identity-on-sx conformance runner.
-#
-# Loads the Erlang-on-SX substrate, the identity library, and every
-# identity test suite via the epoch protocol, collects pass/fail counts,
-# and writes lib/identity/scoreboard.json + .md.
-#
-# Usage:
-#   bash lib/identity/conformance.sh        # run all suites
-#   bash lib/identity/conformance.sh -v     # verbose per-suite
-
-set -uo pipefail
-cd "$(git rev-parse --show-toplevel)"
-
-SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
-if [ ! -x "$SX_SERVER" ]; then
-  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
-fi
-if [ ! -x "$SX_SERVER" ]; then
-  echo "ERROR: sx_server.exe not found." >&2
-  exit 1
-fi
-
-VERBOSE="${1:-}"
-TMPFILE=$(mktemp)
-OUTFILE=$(mktemp)
-trap "rm -f $TMPFILE $OUTFILE" EXIT
-
-# Each suite: name | counter pass | counter total
-SUITES=(
-  "session|id-session-test-pass|id-session-test-count"
-  "token|id-token-test-pass|id-token-test-count"
-  "registry|id-registry-test-pass|id-registry-test-count"
-  "api|id-api-test-pass|id-api-test-count"
-  "oauth|id-oauth-test-pass|id-oauth-test-count"
-  "sso|id-sso-test-pass|id-sso-test-count"
-  "membership|id-membership-test-pass|id-membership-test-count"
-  "cache|id-cache-test-pass|id-cache-test-count"
-  "audit|id-audit-test-pass|id-audit-test-count"
-  "federation|id-fed-test-pass|id-fed-test-count"
-  "expiry|id-expiry-test-pass|id-expiry-test-count"
-  "clients|id-clients-test-pass|id-clients-test-count"
-  "grants|id-grants-test-pass|id-grants-test-count"
-  "device|id-device-test-pass|id-device-test-count"
-  "facade|id-facade-test-pass|id-facade-test-count"
-  "delegation|id-deleg-test-pass|id-deleg-test-count"
-  "session-mgmt|id-smgmt-test-pass|id-smgmt-test-count"
-  "exchange|id-xchg-test-pass|id-xchg-test-count"
-  "introspect|id-intr-test-pass|id-intr-test-count"
-  "par|id-par-test-pass|id-par-test-count"
-  "dynreg|id-dyn-test-pass|id-dyn-test-count"
-  "account|id-acct-test-pass|id-acct-test-count"
-)
-
-cat > "$TMPFILE" << 'EPOCHS'
-(epoch 1)
-(load "lib/erlang/tokenizer.sx")
-(load "lib/erlang/parser.sx")
-(load "lib/erlang/parser-core.sx")
-(load "lib/erlang/parser-expr.sx")
-(load "lib/erlang/parser-module.sx")
-(load "lib/erlang/transpile.sx")
-(load "lib/erlang/runtime.sx")
-(load "lib/identity/session.sx")
-(load "lib/identity/token.sx")
-(load "lib/identity/registry.sx")
-(load "lib/identity/api.sx")
-(load "lib/identity/oauth.sx")
-(load "lib/identity/membership.sx")
-(load "lib/identity/cache.sx")
-(load "lib/identity/audit.sx")
-(load "lib/identity/federation.sx")
-(load "lib/identity/clients.sx")
-(load "lib/identity/device.sx")
-(load "lib/identity/delegation.sx")
-(load "lib/identity/tests/session.sx")
-(load "lib/identity/tests/token.sx")
-(load "lib/identity/tests/registry.sx")
-(load "lib/identity/tests/api.sx")
-(load "lib/identity/tests/oauth.sx")
-(load "lib/identity/tests/sso.sx")
-(load "lib/identity/tests/membership.sx")
-(load "lib/identity/tests/cache.sx")
-(load "lib/identity/tests/audit.sx")
-(load "lib/identity/tests/federation.sx")
-(load "lib/identity/tests/expiry.sx")
-(load "lib/identity/tests/clients.sx")
-(load "lib/identity/tests/grants.sx")
-(load "lib/identity/tests/device.sx")
-(load "lib/identity/tests/facade.sx")
-(load "lib/identity/tests/delegation.sx")
-(load "lib/identity/tests/session_mgmt.sx")
-(load "lib/identity/tests/exchange.sx")
-(load "lib/identity/tests/introspect.sx")
-(load "lib/identity/tests/par.sx")
-(load "lib/identity/tests/dynreg.sx")
-(load "lib/identity/tests/account.sx")
-(epoch 100)
-(eval "(list id-session-test-pass id-session-test-count)")
-(epoch 101)
-(eval "(list id-token-test-pass id-token-test-count)")
-(epoch 102)
-(eval "(list id-registry-test-pass id-registry-test-count)")
-(epoch 103)
-(eval "(list id-api-test-pass id-api-test-count)")
-(epoch 104)
-(eval "(list id-oauth-test-pass id-oauth-test-count)")
-(epoch 105)
-(eval "(list id-sso-test-pass id-sso-test-count)")
-(epoch 106)
-(eval "(list id-membership-test-pass id-membership-test-count)")
-(epoch 107)
-(eval "(list id-cache-test-pass id-cache-test-count)")
-(epoch 108)
-(eval "(list id-audit-test-pass id-audit-test-count)")
-(epoch 109)
-(eval "(list id-fed-test-pass id-fed-test-count)")
-(epoch 110)
-(eval "(list id-expiry-test-pass id-expiry-test-count)")
-(epoch 111)
-(eval "(list id-clients-test-pass id-clients-test-count)")
-(epoch 112)
-(eval "(list id-grants-test-pass id-grants-test-count)")
-(epoch 113)
-(eval "(list id-device-test-pass id-device-test-count)")
-(epoch 114)
-(eval "(list id-facade-test-pass id-facade-test-count)")
-(epoch 115)
-(eval "(list id-deleg-test-pass id-deleg-test-count)")
-(epoch 116)
-(eval "(list id-smgmt-test-pass id-smgmt-test-count)")
-(epoch 117)
-(eval "(list id-xchg-test-pass id-xchg-test-count)")
-(epoch 118)
-(eval "(list id-intr-test-pass id-intr-test-count)")
-(epoch 119)
-(eval "(list id-par-test-pass id-par-test-count)")
-(epoch 120)
-(eval "(list id-dyn-test-pass id-dyn-test-count)")
-(epoch 121)
-(eval "(list id-acct-test-pass id-acct-test-count)")
-EPOCHS
-
-timeout 1200 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1
-
-parse_pair() {
-  local epoch="$1"
-  local line
-  line=$(grep -A1 "^(ok-len $epoch " "$OUTFILE" | tail -1)
-  echo "$line" | sed -E 's/[()]//g'
-}
-
-TOTAL_PASS=0
-TOTAL_COUNT=0
-JSON_SUITES=""
-MD_ROWS=""
-
-idx=0
-for entry in "${SUITES[@]}"; do
-  name="${entry%%|*}"
-  epoch=$((100 + idx))
-  pair=$(parse_pair "$epoch")
-  pass=$(echo "$pair" | awk '{print $1}')
-  count=$(echo "$pair" | awk '{print $2}')
-  if [ -z "$pass" ] || [ -z "$count" ]; then
-    pass=0
-    count=0
-  fi
-  TOTAL_PASS=$((TOTAL_PASS + pass))
-  TOTAL_COUNT=$((TOTAL_COUNT + count))
-  status="ok"
-  marker="✅"
-  if [ "$pass" != "$count" ]; then
-    status="fail"
-    marker="❌"
-  fi
-  if [ "$VERBOSE" = "-v" ]; then
-    printf "  %-12s %s/%s\n" "$name" "$pass" "$count"
-  fi
-  if [ -n "$JSON_SUITES" ]; then JSON_SUITES+=","; fi
-  JSON_SUITES+=$'\n    '
-  JSON_SUITES+="{\"name\":\"$name\",\"pass\":$pass,\"total\":$count,\"status\":\"$status\"}"
-  MD_ROWS+="| $marker | $name | $pass | $count |"$'\n'
-  idx=$((idx + 1))
-done
-
-printf '\nidentity-on-sx conformance: %d / %d\n' "$TOTAL_PASS" "$TOTAL_COUNT"
-
-cat > lib/identity/scoreboard.json <<JSON
-{
-  "language": "identity",
-  "total_pass": $TOTAL_PASS,
-  "total": $TOTAL_COUNT,
-  "suites": [$JSON_SUITES
-  ]
-}
-JSON
-
-cat > lib/identity/scoreboard.md <<MD
-# identity-on-sx Scoreboard
-
-**Total: ${TOTAL_PASS} / ${TOTAL_COUNT} tests passing**
-
-|  | Suite | Pass | Total |
-|---|---|---|---|
-$MD_ROWS
-
-Generated by \`lib/identity/conformance.sh\`.
-MD
-
-if [ "$TOTAL_PASS" -eq "$TOTAL_COUNT" ]; then
-  exit 0
-else
-  exit 1
-fi

lib/identity/delegation.sx

@@ -1,34 +0,0 @@
-;; identity/delegation.sx — the identity -> acl delegation boundary.
-;;
-;; This is the loop's central architectural rule made concrete:
-;; AUTHENTICATION is identity's job; AUTHORIZATION is acl's. A request is
-;; checked in two stages, and the order matters:
-;;
-;;   1. identity proves WHO via the opaque token (introspect). If the token
-;;      is inactive, the answer is {error, unauthenticated} — a 401. acl is
-;;      NEVER consulted; \"I don't know who you are\" is not a permission
-;;      question.
-;;   2. only for an authenticated subject does identity construct the
-;;      permission query {Subject, Scope, Action, Resource} and HAND IT OFF
-;;      to acl. acl returns permit | deny; deny is {error, forbidden} — a
-;;      403. identity itself never decides permission.
-;;
-;; The real decider is acl-on-sx (Datalog), which runs as a different
-;; guest language on SX and is wired in at the integration layer. Here the
-;; acl side is a labelled STUB process so the boundary is exercised: it
-;; permits when the Action is within the token's granted Scope. Swap the
-;; stub pid for the acl adapter and the boundary is unchanged.
-;;
-;;   check(TokReg, Acl, Token, Action, Resource) ->
-;;     {ok, Subject} | {error, unauthenticated} | {error, forbidden}
-
-(define
-  identity-delegation-source
-  "-module(identity_delegation).\n\n   check(TokReg, Acl, Token, Action, Resource) ->\n     case identity_tokens:introspect(TokReg, Token) of\n       {inactive} ->\n         {error, unauthenticated};\n       {active, Subject, _Client, Scope} ->\n         Acl ! {acl_query, Subject, Scope, Action, Resource, self()},\n         receive {acl_verdict, V} ->\n           case V of\n             permit -> {ok, Subject};\n             deny -> {error, forbidden}\n           end\n         end\n     end.\n\n   %% --- stub acl decider (stands in for acl-on-sx / Datalog) ---\n   %% Permits iff the Action is one of the token's granted scopes. The real\n   %% acl decides on rules + facts; this only exercises the handoff shape.\n   stub_acl() ->\n     spawn(fun () -> acl_loop() end).\n\n   acl_loop() ->\n     receive\n       {acl_query, _Subject, Scope, Action, _Resource, From} ->\n         From ! {acl_verdict, decide(Action, Scope)},\n         acl_loop();\n       stop ->\n         ok\n     end.\n\n   decide(Action, Scope) ->\n     case member(Action, Scope) of\n       true -> permit;\n       false -> deny\n     end.\n\n   member(_, []) -> false;\n   member(X, [Y | Rest]) ->\n     case X =:= Y of\n       true -> true;\n       false -> member(X, Rest)\n     end.")
-
-(define
-  identity-load-delegation!
-  (fn
-    ()
-    (identity-load-token!)
-    (erlang-load-module identity-delegation-source)))

lib/identity/device.sx

@@ -1,33 +0,0 @@
-;; identity/device.sx — the device authorization grant (RFC 8628).
-;;
-;; For input-constrained devices (TVs, CLIs): the device gets a device_code
-;; + user_code, the user approves out-of-band on another device, and the
-;; device polls the token endpoint until it flips. The poll status machine
-;; is RFC 8628 §3.5:
-;;
-;;   authorize(ClientId, Scope) -> {ok, DeviceCode, UserCode}
-;;   approve(UserCode, Subject) -> ok | {error, ...}   (the human's browser)
-;;   deny(UserCode)             -> ok | {error, ...}
-;;   poll(DeviceCode) ->
-;;     pending  -> {error, authorization_pending}
-;;     denied   -> {error, access_denied}
-;;     approved -> {ok, Token}        (device code is then single-use)
-;;     consumed -> {error, invalid_grant}
-;;     unknown  -> {error, invalid_grant}
-;;
-;; Tokens are grant-backed (token.sx) so revocation stays real. Device-code
-;; expiry and slow_down (poll-rate limiting) are deferred — the substrate
-;; has no wall clock and the core status machine is the security-relevant
-;; part; introspect via token.sx already honours token TTL.
-;;
-;; State: loop(TokReg, Requests) where Requests is
-;;   [{DeviceCode, UserCode, ClientId, Scope, Status}]
-;;   Status :: pending | {approved, Subject} | denied | consumed
-
-(define
-  identity-device-source
-  "-module(identity_device).\n\n   start() ->\n     spawn(fun () ->\n       TokReg = identity_tokens:start(),\n       loop(TokReg, [])\n     end).\n\n   authorize(D, ClientId, Scope) ->\n     D ! {authorize, ClientId, Scope, self()},\n     receive {device_reply, R} -> R end.\n\n   approve(D, UserCode, Subject) ->\n     D ! {approve, UserCode, Subject, self()},\n     receive {device_reply, R} -> R end.\n\n   deny(D, UserCode) ->\n     D ! {deny, UserCode, self()},\n     receive {device_reply, R} -> R end.\n\n   poll(D, DeviceCode) ->\n     D ! {poll, DeviceCode, self()},\n     receive {device_reply, R} -> R end.\n\n   introspect(D, Token) ->\n     D ! {introspect, Token, self()},\n     receive {device_reply, R} -> R end.\n\n   loop(TokReg, Requests) ->\n     receive\n       {authorize, ClientId, Scope, From} ->\n         DeviceCode = make_ref(),\n         UserCode = make_ref(),\n         From ! {device_reply, {ok, DeviceCode, UserCode}},\n         loop(TokReg, [{DeviceCode, UserCode, ClientId, Scope, pending} | Requests]);\n       {approve, UserCode, Subject, From} ->\n         case find_user(UserCode, Requests) of\n           none ->\n             From ! {device_reply, {error, unknown_code}},\n             loop(TokReg, Requests);\n           {ok, {_, _, _, _, pending}} ->\n             From ! {device_reply, ok},\n             loop(TokReg, set_user(UserCode, {approved, Subject}, Requests));\n           {ok, {_, _, _, _, St}} ->\n             From ! {device_reply, {error, St}},\n             loop(TokReg, Requests)\n         end;\n       {deny, UserCode, From} ->\n         case find_user(UserCode, Requests) of\n           none ->\n             From ! {device_reply, {error, unknown_code}},\n             loop(TokReg, Requests);\n           {ok, {_, _, _, _, pending}} ->\n             From ! {device_reply, ok},\n             loop(TokReg, set_user(UserCode, denied, Requests));\n           {ok, {_, _, _, _, St}} ->\n             From ! {device_reply, {error, St}},\n             loop(TokReg, Requests)\n         end;\n       {poll, DeviceCode, From} ->\n         case find_device(DeviceCode, Requests) of\n           none ->\n             From ! {device_reply, {error, invalid_grant}},\n             loop(TokReg, Requests);\n           {ok, {_, _, _, _, pending}} ->\n             From ! {device_reply, {error, authorization_pending}},\n             loop(TokReg, Requests);\n           {ok, {_, _, _, _, denied}} ->\n             From ! {device_reply, {error, access_denied}},\n             loop(TokReg, Requests);\n           {ok, {_, _, _, _, consumed}} ->\n             From ! {device_reply, {error, invalid_grant}},\n             loop(TokReg, Requests);\n           {ok, {_, _, ClientId, Scope, {approved, Subject}}} ->\n             {ok, Token} = identity_tokens:issue(TokReg, Subject, ClientId, Scope),\n             From ! {device_reply, {ok, Token}},\n             loop(TokReg, set_device(DeviceCode, consumed, Requests))\n         end;\n       {introspect, Token, From} ->\n         From ! {device_reply, identity_tokens:introspect(TokReg, Token)},\n         loop(TokReg, Requests);\n       {stop, From} ->\n         From ! {device_reply, ok}\n     end.\n\n   find_device(_, []) -> none;\n   find_device(DCode, [{D, U, C, S, St} | Rest]) ->\n     case D =:= DCode of\n       true -> {ok, {D, U, C, S, St}};\n       false -> find_device(DCode, Rest)\n     end.\n\n   find_user(_, []) -> none;\n   find_user(UCode, [{D, U, C, S, St} | Rest]) ->\n     case U =:= UCode of\n       true -> {ok, {D, U, C, S, St}};\n       false -> find_user(UCode, Rest)\n     end.\n\n   set_device(_, _, []) -> [];\n   set_device(DCode, NewSt, [{D, U, C, S, St} | Rest]) ->\n     case D =:= DCode of\n       true -> [{D, U, C, S, NewSt} | Rest];\n       false -> [{D, U, C, S, St} | set_device(DCode, NewSt, Rest)]\n     end.\n\n   set_user(_, _, []) -> [];\n   set_user(UCode, NewSt, [{D, U, C, S, St} | Rest]) ->\n     case U =:= UCode of\n       true -> [{D, U, C, S, NewSt} | Rest];\n       false -> [{D, U, C, S, St} | set_user(UCode, NewSt, Rest)]\n     end.")
-
-(define
-  identity-load-device!
-  (fn () (identity-load-token!) (erlang-load-module identity-device-source)))

lib/identity/federation.sx

@@ -1,30 +0,0 @@
-;; identity/federation.sx — federated identity: peer-asserted subjects,
-;; advisory and trust-gated.
-;;
-;; A peer instance can assert \"this remote subject authenticated with me\".
-;; We accept such an assertion ONLY from a peer we explicitly trust
-;; (trust-gated); an assertion from an unknown peer is {error, untrusted},
-;; never silently honoured. Even when accepted, the resulting identity is
-;; ADVISORY: it is flagged peer_asserted with its origin peer, never
-;; promoted to local authority. Downstream (acl) decides how much a
-;; peer-asserted identity may do; identity only records who asserted it.
-;;
-;; Cross-instance subject mapping turns a (Peer, RemoteSubject) pair into a
-;; stable local subject. By default it is namespaced — {federated, Peer,
-;; RemoteSubject} — so two peers' \"alice\" never collide; an explicit map
-;; can alias a remote subject to a local one.
-;;
-;;   trust(F, Peer) / untrust(F, Peer) / trusted(F, Peer)
-;;   map(F, Peer, Remote, Local)            -> ok    (optional alias)
-;;   resolve(F, Peer, Remote)               -> {ok, LocalSubject}
-;;   assert_id(F, Peer, Remote)             -> {ok, LocalSubject}
-;;                                           | {error, untrusted}
-;;   provenance(F, LocalSubject)            -> {peer_asserted, Peer} | {local}
-
-(define
-  identity-federation-source
-  "-module(identity_federation).\n\n   start() ->\n     spawn(fun () -> loop([], [], []) end).\n\n   trust(F, Peer) ->\n     F ! {trust, Peer, self()},\n     receive {fed_reply, R} -> R end.\n\n   untrust(F, Peer) ->\n     F ! {untrust, Peer, self()},\n     receive {fed_reply, R} -> R end.\n\n   trusted(F, Peer) ->\n     F ! {trusted, Peer, self()},\n     receive {fed_reply, R} -> R end.\n\n   map(F, Peer, Remote, Local) ->\n     F ! {map, Peer, Remote, Local, self()},\n     receive {fed_reply, R} -> R end.\n\n   resolve(F, Peer, Remote) ->\n     F ! {resolve, Peer, Remote, self()},\n     receive {fed_reply, R} -> R end.\n\n   assert_id(F, Peer, Remote) ->\n     F ! {assert_id, Peer, Remote, self()},\n     receive {fed_reply, R} -> R end.\n\n   provenance(F, Local) ->\n     F ! {provenance, Local, self()},\n     receive {fed_reply, R} -> R end.\n\n   loop(Trusted, Maps, Asserted) ->\n     receive\n       {trust, Peer, From} ->\n         From ! {fed_reply, ok},\n         loop(add_unique(Peer, Trusted), Maps, Asserted);\n       {untrust, Peer, From} ->\n         From ! {fed_reply, ok},\n         loop(drop(Peer, Trusted), Maps, Asserted);\n       {trusted, Peer, From} ->\n         From ! {fed_reply, member(Peer, Trusted)},\n         loop(Trusted, Maps, Asserted);\n       {map, Peer, Remote, Local, From} ->\n         From ! {fed_reply, ok},\n         loop(Trusted, [{{Peer, Remote}, Local} | drop_map(Peer, Remote, Maps)], Asserted);\n       {resolve, Peer, Remote, From} ->\n         From ! {fed_reply, {ok, resolve_local(Peer, Remote, Maps)}},\n         loop(Trusted, Maps, Asserted);\n       {assert_id, Peer, Remote, From} ->\n         case member(Peer, Trusted) of\n           false ->\n             From ! {fed_reply, {error, untrusted}},\n             loop(Trusted, Maps, Asserted);\n           true ->\n             Local = resolve_local(Peer, Remote, Maps),\n             From ! {fed_reply, {ok, Local}},\n             loop(Trusted, Maps, [{Local, Peer} | drop_assert(Local, Asserted)])\n         end;\n       {provenance, Local, From} ->\n         case find_assert(Local, Asserted) of\n           {ok, Peer} -> From ! {fed_reply, {peer_asserted, Peer}};\n           none -> From ! {fed_reply, {local}}\n         end,\n         loop(Trusted, Maps, Asserted);\n       {stop, From} ->\n         From ! {fed_reply, ok}\n     end.\n\n   resolve_local(Peer, Remote, Maps) ->\n     case find_map(Peer, Remote, Maps) of\n       {ok, Local} -> Local;\n       none -> {federated, Peer, Remote}\n     end.\n\n   find_map(_, _, []) -> none;\n   find_map(Peer, Remote, [{{P, R}, Local} | Rest]) ->\n     case same(P, Peer, R, Remote) of\n       true -> {ok, Local};\n       false -> find_map(Peer, Remote, Rest)\n     end.\n\n   drop_map(_, _, []) -> [];\n   drop_map(Peer, Remote, [{{P, R}, Local} | Rest]) ->\n     case same(P, Peer, R, Remote) of\n       true -> drop_map(Peer, Remote, Rest);\n       false -> [{{P, R}, Local} | drop_map(Peer, Remote, Rest)]\n     end.\n\n   same(P, Peer, R, Remote) ->\n     case P =:= Peer of\n       true -> R =:= Remote;\n       false -> false\n     end.\n\n   find_assert(_, []) -> none;\n   find_assert(Local, [{L, Peer} | Rest]) ->\n     case L =:= Local of\n       true -> {ok, Peer};\n       false -> find_assert(Local, Rest)\n     end.\n\n   drop_assert(_, []) -> [];\n   drop_assert(Local, [{L, Peer} | Rest]) ->\n     case L =:= Local of\n       true -> drop_assert(Local, Rest);\n       false -> [{L, Peer} | drop_assert(Local, Rest)]\n     end.\n\n   add_unique(X, Xs) ->\n     case member(X, Xs) of\n       true -> Xs;\n       false -> [X | Xs]\n     end.\n\n   drop(_, []) -> [];\n   drop(X, [Y | Rest]) ->\n     case X =:= Y of\n       true -> drop(X, Rest);\n       false -> [Y | drop(X, Rest)]\n     end.\n\n   member(_, []) -> false;\n   member(X, [Y | Rest]) ->\n     case X =:= Y of\n       true -> true;\n       false -> member(X, Rest)\n     end.")
-
-(define
-  identity-load-federation!
-  (fn () (erlang-load-module identity-federation-source)))

lib/identity/membership.sx

@@ -1,31 +0,0 @@
-;; identity/membership.sx — coop membership state + per-app projection.
-;;
-;; Membership is canonical subject state held by one process, a guarded
-;; state machine (invalid transitions are explicit errors, never silent
-;; no-ops):
-;;
-;;   none --request--> pending --approve--> active
-;;   active --lapse--> lapsed --reinstate--> active
-;;   {pending|active|lapsed} --revoke--> revoked   (terminal)
-;;
-;; A per-app GRANT PROJECTION renders that one canonical state into the
-;; view a given client app consumes — mirroring rose-ash's per-app grant
-;; verification. The projection is pure identity: it reports WHAT the
-;; subject's membership is for that app; it does NOT decide whether the
-;; app should let them in. That permission question is acl's, keyed off
-;; this projection.
-;;
-;;   project(Subject, App) ->
-;;     active  -> {member, Tier, App}
-;;     pending -> {pending, App}
-;;     lapsed  -> {lapsed, App}
-;;     revoked -> {denied, App}
-;;     none    -> {non_member, App}
-
-(define
-  identity-membership-source
-  "-module(identity_membership).\n\n   start() ->\n     spawn(fun () -> loop([]) end).\n\n   request(M, Subject, Tier) ->\n     M ! {request, Subject, Tier, self()},\n     receive {membership_reply, R} -> R end.\n\n   approve(M, Subject) ->\n     M ! {approve, Subject, self()},\n     receive {membership_reply, R} -> R end.\n\n   lapse(M, Subject) ->\n     M ! {lapse, Subject, self()},\n     receive {membership_reply, R} -> R end.\n\n   reinstate(M, Subject) ->\n     M ! {reinstate, Subject, self()},\n     receive {membership_reply, R} -> R end.\n\n   revoke(M, Subject) ->\n     M ! {revoke, Subject, self()},\n     receive {membership_reply, R} -> R end.\n\n   status(M, Subject) ->\n     M ! {status, Subject, self()},\n     receive {membership_reply, R} -> R end.\n\n   project(M, Subject, App) ->\n     M ! {project, Subject, App, self()},\n     receive {membership_reply, R} -> R end.\n\n   loop(Members) ->\n     receive\n       {request, Subject, Tier, From} ->\n         case find(Subject, Members) of\n           none ->\n             From ! {membership_reply, ok},\n             loop([{Subject, {pending, Tier}} | Members]);\n           {ok, _} ->\n             From ! {membership_reply, {error, exists}},\n             loop(Members)\n         end;\n       {approve, Subject, From} ->\n         case find(Subject, Members) of\n           none ->\n             From ! {membership_reply, {error, not_found}},\n             loop(Members);\n           {ok, {pending, Tier}} ->\n             From ! {membership_reply, ok},\n             loop(set_record(Subject, {active, Tier}, Members));\n           {ok, {St, _}} ->\n             From ! {membership_reply, {error, St}},\n             loop(Members)\n         end;\n       {lapse, Subject, From} ->\n         case find(Subject, Members) of\n           none ->\n             From ! {membership_reply, {error, not_found}},\n             loop(Members);\n           {ok, {active, Tier}} ->\n             From ! {membership_reply, ok},\n             loop(set_record(Subject, {lapsed, Tier}, Members));\n           {ok, {St, _}} ->\n             From ! {membership_reply, {error, St}},\n             loop(Members)\n         end;\n       {reinstate, Subject, From} ->\n         case find(Subject, Members) of\n           none ->\n             From ! {membership_reply, {error, not_found}},\n             loop(Members);\n           {ok, {lapsed, Tier}} ->\n             From ! {membership_reply, ok},\n             loop(set_record(Subject, {active, Tier}, Members));\n           {ok, {St, _}} ->\n             From ! {membership_reply, {error, St}},\n             loop(Members)\n         end;\n       {revoke, Subject, From} ->\n         case find(Subject, Members) of\n           none ->\n             From ! {membership_reply, {error, not_found}},\n             loop(Members);\n           {ok, {_, Tier}} ->\n             From ! {membership_reply, ok},\n             loop(set_record(Subject, {revoked, Tier}, Members))\n         end;\n       {status, Subject, From} ->\n         case find(Subject, Members) of\n           none -> From ! {membership_reply, {none}};\n           {ok, {St, Tier}} -> From ! {membership_reply, {ok, St, Tier}}\n         end,\n         loop(Members);\n       {project, Subject, App, From} ->\n         From ! {membership_reply, project_view(Subject, App, Members)},\n         loop(Members);\n       {stop, From} ->\n         From ! {membership_reply, ok}\n     end.\n\n   project_view(Subject, App, Members) ->\n     case find(Subject, Members) of\n       none -> {non_member, App};\n       {ok, {active, Tier}} -> {member, Tier, App};\n       {ok, {pending, _}} -> {pending, App};\n       {ok, {lapsed, _}} -> {lapsed, App};\n       {ok, {revoked, _}} -> {denied, App}\n     end.\n\n   set_record(_, _, []) -> [];\n   set_record(Subject, Rec, [{S, Old} | Rest]) ->\n     case S =:= Subject of\n       true -> [{S, Rec} | Rest];\n       false -> [{S, Old} | set_record(Subject, Rec, Rest)]\n     end.\n\n   find(_, []) -> none;\n   find(Key, [{K, V} | Rest]) ->\n     case K =:= Key of\n       true -> {ok, V};\n       false -> find(Key, Rest)\n     end.")
-
-(define
-  identity-load-membership!
-  (fn () (erlang-load-module identity-membership-source)))