Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
70 lines
1.6 KiB
Plaintext
70 lines
1.6 KiB
Plaintext
;; content-on-sx — relative block reorder.
|
|
;;
|
|
;; Move a top-level block to just before / after another block by id — more
|
|
;; ergonomic than the index-based doc-move. No-op if either id is missing.
|
|
;; Immutable; composes the doc.sx list helpers.
|
|
;;
|
|
;; 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)))))))
|