coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add render stepper to home page
All checks were successful
Build and Deploy / build-and-deploy (push) Successful in 22s
Details

Browse Source 
Replace header source view with interactive CEK render stepper.
Auto-parses on mount, step forward/back through DOM construction
with CSSX styling. Uses lake for preview persistence.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-14 20:14:00 +00:00
parent 623f947b52
commit 9e0b81e31a
2 changed files with 123 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
sx/sx/docs-content.sx
View File

@@ -2,7 +2,12 @@
(defcomp ~docs-content/home-content ()
(div :id "main-content" :class "max-w-3xl mx-auto px-4 py-6"
(~docs/code :code (highlight (component-source "~layouts/header") "lisp"))))
(~home/stepper :code (highlight "(div (~cssx/tw :tokens \"p-6 rounded-lg border border-stone-200 bg-white text-center\")
(h1 (~cssx/tw :tokens \"text-3xl font-bold mb-2\")
(span (~cssx/tw :tokens \"text-rose-500\") \"the \")
(span (~cssx/tw :tokens \"text-amber-500\") \"joy \")
(span (~cssx/tw :tokens \"text-emerald-500\") \"of \")
(span (~cssx/tw :tokens \"text-violet-600 text-4xl\") \"sx\")))" "lisp"))))
(defcomp ~docs-content/docs-introduction-content ()
(~docs/page :title "Introduction"

117
sx/sx/home-stepper.sx Normal file
View File

@@ -0,0 +1,117 @@
(defisland ~home/stepper (&key code)
(let ((source "(div (~cssx/tw :tokens \"p-6 rounded-lg border border-stone-200 bg-white text-center\")\n (h1 (~cssx/tw :tokens \"text-3xl font-bold mb-2\")\n (span (~cssx/tw :tokens \"text-rose-500\") \"the \")\n (span (~cssx/tw :tokens \"text-amber-500\") \"joy \")\n (span (~cssx/tw :tokens \"text-emerald-500\") \"of \")\n (span (~cssx/tw :tokens \"text-violet-600 text-4xl\") \"sx\")))")
(steps (signal (list)))
(step-idx (signal 0))
(dom-stack-sig (signal (list))))
(letrec
((split-tag (fn (expr result)
(cond
(not (list? expr))
(append! result {"type" "leaf" "expr" expr})
(empty? expr) nil
(not (= (type-of (first expr)) "symbol"))
(append! result {"type" "leaf" "expr" expr})
(is-html-tag? (symbol-name (first expr)))
(let ((ctag (symbol-name (first expr)))
(cargs (rest expr))
(cch (list))
(cat (list))
(spreads (list))
(ckw false))
(for-each (fn (a)
(cond
(= (type-of a) "keyword") (do (set! ckw true) (append! cat a))
ckw (do (set! ckw false) (append! cat a))
(and (list? a) (not (empty? a))
(= (type-of (first a)) "symbol")
(starts-with? (symbol-name (first a)) "~"))
(do (set! ckw false) (append! spreads a))
:else (do (set! ckw false) (append! cch a))))
cargs)
(append! result {"type" "open" "tag" ctag "attrs" cat "spreads" spreads})
(for-each (fn (c) (split-tag c result)) cch)
(append! result {"type" "close" "tag" ctag}))
:else
(append! result {"type" "expr" "expr" expr}))))
(get-preview (fn () (dom-query "[data-sx-lake=\"home-preview\"]")))
(get-stack (fn () (deref dom-stack-sig)))
(set-stack (fn (v) (reset! dom-stack-sig v)))
(push-stack (fn (el) (reset! dom-stack-sig (append (deref dom-stack-sig) (list el)))))
(pop-stack (fn ()
(let ((s (deref dom-stack-sig)))
(when (> (len s) 1)
(reset! dom-stack-sig (slice s 0 (- (len s) 1)))))))
(do-step (fn ()
(when (< (deref step-idx) (len (deref steps)))
;; Lazy init: set up stack on first step
(when (empty? (get-stack))
(let ((p (get-preview)))
(when p (set-stack (list p)))))
(let ((step (nth (deref steps) (deref step-idx)))
(step-type (get step "type"))
(parent (if (empty? (get-stack)) (get-preview) (last (get-stack)))))
(cond
(= step-type "open")
(let ((el (dom-create-element (get step "tag") nil))
(attrs (get step "attrs"))
(spreads (or (get step "spreads") (list))))
(let loop ((i 0))
(when (< i (len attrs))
(dom-set-attr el (keyword-name (nth attrs i)) (nth attrs (+ i 1)))
(loop (+ i 2))))
(for-each (fn (sp)
(let ((result (eval-expr sp (make-env))))
(when (and result (spread? result))
(let ((sattrs (spread-attrs result)))
(for-each (fn (k)
(if (= k "class")
(dom-set-attr el "class"
(str (or (dom-get-attr el "class") "") " " (get sattrs k)))
(dom-set-attr el k (get sattrs k))))
(keys sattrs))))))
spreads)
(when parent (dom-append parent el))
(push-stack el))
(= step-type "close")
(pop-stack)
(= step-type "leaf")
(when parent
(let ((val (get step "expr")))
(dom-append parent (create-text-node (if (string? val) val (str val))))))
(= step-type "expr")
(let ((rendered (render-to-dom (get step "expr") (make-env) nil)))
(when (and parent rendered)
(dom-append parent rendered)))))
(swap! step-idx inc))))
(do-back (fn ()
(when (> (deref step-idx) 0)
(let ((target (- (deref step-idx) 1))
(container (get-preview)))
(when container (dom-set-prop container "innerHTML" ""))
(set-stack (list (get-preview)))
(reset! step-idx 0)
(for-each (fn (_) (do-step)) (slice (deref steps) 0 target)))))))
;; Auto-parse at mount — just build steps, don't touch DOM yet
(let ((parsed (sx-parse source)))
(when (not (empty? parsed))
(let ((result (list)))
(split-tag (first parsed) result)
(reset! steps result))))
(div :class "space-y-4"
(~docs/code :code code)
(div :class "flex items-center justify-center gap-2"
(button :on-click (fn (e) (do-back))
:class (str "px-3 py-1.5 rounded text-sm "
(if (> (deref step-idx) 0)
"bg-stone-200 text-stone-700 hover:bg-stone-300"
"bg-stone-100 text-stone-300 cursor-not-allowed"))
"\u25c0")
(button :on-click (fn (e) (do-step))
:class (str "px-3 py-1.5 rounded text-sm "
(if (< (deref step-idx) (len (deref steps)))
"bg-violet-500 text-white hover:bg-violet-600"
"bg-violet-200 text-violet-400 cursor-not-allowed"))
"Step \u25b6")
(span :class "text-xs text-stone-400"
(str (deref step-idx) " / " (len (deref steps)))))
(lake :id "home-preview")))))