content: nested block trees (section.sx) + 25 tests (410/410)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
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>
This commit is contained in:
103
lib/content/section.sx
Normal file
103
lib/content/section.sx
Normal file
@@ -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))))
|
||||
Reference in New Issue
Block a user