giles
6e0edc347b
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
104 lines
3.3 KiB
Plaintext
104 lines
3.3 KiB
Plaintext
;; 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))))
|