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