giles
e9316b37c2
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s
insert/move were top-level only; a block could never move into/out of a section. content/move-into (relocate to a section child at index, tree-wide) + content/promote (lift nested block to top level, subtree intact). Pure tree transforms like the rest of move.sx; cycle-safe (rejects moving a block into its own descendant). +13 tests. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
129 lines
3.5 KiB
Plaintext
129 lines
3.5 KiB
Plaintext
;; 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)))))))
|