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

Add spread + collect primitives, rewrite ~cssx/tw as defcomp

Browse Source 
New SX primitives for child-to-parent communication in the render tree:
- spread type: make-spread, spread?, spread-attrs — child injects attrs
  onto parent element (class joins with space, style with semicolon)
- collect!/collected/clear-collected! — render-time accumulation with
  dedup into named buckets

~cssx/tw is now a proper defcomp returning a spread value instead of a
macro wrapping children. ~cssx/flush reads collected "cssx" rules and
emits a single <style data-cssx> tag.

All four render adapters (html, async, dom, aser) handle spread values.
Both bootstraps (Python + JS) regenerated. Also fixes length→len in
cssx.sx (length was never a registered primitive).

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-13 02:38:31 +00:00
parent c2efa192c5
commit 41097eeef9
15 changed files with 844 additions and 230 deletions
Download Patch File Download Diff File Expand all files Collapse all files

172
shared/sx/templates/cssx.sx
View File

@@ -1,15 +1,23 @@
;; @client — send all define forms to browser for client-side use.
;; CSSX — computed CSS from s-expressions.
;;
;; Tailwind-style utility component. Write styling as utility tokens:
;; Tailwind-style utility component using spread + collect primitives.
;; Use as a child of any element — injects classes onto the parent:
;;
;; (~cssx/tw "bg-yellow-199 text-violet-700 p-4 font-bold"
;; (div "content"))
;; (div (~cssx/tw "bg-yellow-199 text-violet-700 p-4 font-bold")
;; "content")
;;
;; (~cssx/tw "hover:bg-rose-500 md:text-xl"
;; (button "click me"))
;; (button (~cssx/tw "hover:bg-rose-500 md:text-xl")
;; "click me")
;;
;; Each token becomes a deterministic class + JIT CSS rule.
;; Rules are collected into the "cssx" bucket, flushed once by ~cssx/flush.
;; No wrapper elements, no per-element <style> tags.
;;
;; Reusable style variables:
;; (define fancy (~cssx/tw "font-bold text-violet-700 text-4xl"))
;; (div fancy "styled content")
;;
;; Each token becomes a deterministic class + JIT <style> rule.
;; This is one instance of the CSSX component pattern — other styling
;; components are possible with different vocabulary.
@@ -192,11 +200,11 @@
(fn (tmpl v)
(let ((i (index-of tmpl "{v}")))
(if (< i 0) tmpl
(let ((result (str (substring tmpl 0 i) v (substring tmpl (+ i 3) (length tmpl)))))
(let ((result (str (substring tmpl 0 i) v (substring tmpl (+ i 3) (len tmpl)))))
;; Handle templates with multiple {v} (e.g. padding-left:{v};padding-right:{v})
(let ((j (index-of result "{v}")))
(if (< j 0) result
(str (substring result 0 j) v (substring result (+ j 3) (length result))))))))))
(str (substring result 0 j) v (substring result (+ j 3) (len result))))))))))
;; Resolve a base utility token (no state/bp prefix) → CSS declaration string or nil.
;; Tries matchers in order: colour, text-size, text-align, font, spacing, display, max-w, rounded, opacity.
@@ -211,11 +219,11 @@
;; Colour utilities: bg-{colour}-{shade}, text-{colour}-{shade}, border-{colour}-{shade}
;; ---------------------------------------------------------
(and (get cssx-colour-props head)
(>= (length rest) 2)
(>= (len rest) 2)
(not (nil? (parse-int (last rest) nil)))
(not (nil? (get colour-bases (join "-" (slice rest 0 (- (length rest) 1)))))))
(not (nil? (get colour-bases (join "-" (slice rest 0 (- (len rest) 1)))))))
(let ((css-prop (get cssx-colour-props head))
(cname (join "-" (slice rest 0 (- (length rest) 1))))
(cname (join "-" (slice rest 0 (- (len rest) 1))))
(shade (parse-int (last rest) 0)))
(str css-prop ":" (colour cname shade)))
@@ -223,7 +231,7 @@
;; Text size: text-{size-name} (e.g. text-xl, text-2xl)
;; ---------------------------------------------------------
(and (= head "text")
(= (length rest) 1)
(= (len rest) 1)
(not (nil? (get cssx-sizes (first rest)))))
(get cssx-sizes (first rest))
@@ -234,7 +242,7 @@
;; Text alignment: text-left, text-center, text-right, text-justify
;; ---------------------------------------------------------
(and (= head "text")
(= (length rest) 1)
(= (len rest) 1)
(get cssx-alignments (first rest)))
(str "text-align:" (first rest))
@@ -242,7 +250,7 @@
;; Font weight: font-bold, font-semibold, etc.
;; ---------------------------------------------------------
(and (= head "font")
(= (length rest) 1)
(= (len rest) 1)
(not (nil? (get cssx-weights (first rest)))))
(str "font-weight:" (get cssx-weights (first rest)))
@@ -250,7 +258,7 @@
;; Font family: font-sans, font-serif, font-mono
;; ---------------------------------------------------------
(and (= head "font")
(= (length rest) 1)
(= (len rest) 1)
(not (nil? (get cssx-families (first rest)))))
(str "font-family:" (get cssx-families (first rest)))
@@ -258,7 +266,7 @@
;; Spacing: p-4, px-2, mt-8, mx-auto, etc.
;; ---------------------------------------------------------
(and (get cssx-spacing-props head)
(= (length rest) 1))
(= (len rest) 1))
(let ((tmpl (get cssx-spacing-props head))
(v (cssx-spacing-value (first rest))))
(if (nil? v) nil (cssx-template tmpl v)))
@@ -266,12 +274,12 @@
;; ---------------------------------------------------------
;; Display: block, flex, grid, hidden, inline, inline-block
;; ---------------------------------------------------------
(and (= (length parts) 1)
(and (= (len parts) 1)
(not (nil? (get cssx-displays head))))
(str "display:" (get cssx-displays head))
;; Inline-block, inline-flex (multi-word)
(and (= (length parts) 2)
(and (= (len parts) 2)
(not (nil? (get cssx-displays token))))
(str "display:" (get cssx-displays token))
@@ -279,7 +287,7 @@
;; Max-width: max-w-xl, max-w-3xl, max-w-prose
;; ---------------------------------------------------------
(and (= head "max")
(>= (length rest) 2)
(>= (len rest) 2)
(= (first rest) "w"))
(let ((val-name (join "-" (slice rest 1)))
(val (get cssx-max-widths val-name)))
@@ -305,7 +313,7 @@
;; Opacity: opacity-{n} (0-100)
;; ---------------------------------------------------------
(and (= head "opacity")
(= (length rest) 1))
(= (len rest) 1))
(let ((n (parse-int (first rest) nil)))
(if (nil? n) nil (str "opacity:" (/ n 100))))
@@ -313,7 +321,7 @@
;; Width/height: w-{n}, h-{n}, w-full, h-full, h-screen
;; ---------------------------------------------------------
(and (or (= head "w") (= head "h"))
(= (length rest) 1))
(= (len rest) 1))
(let ((prop (if (= head "w") "width" "height"))
(val (first rest)))
(cond
@@ -331,30 +339,30 @@
;; Gap: gap-{n}
;; ---------------------------------------------------------
(and (= head "gap")
(= (length rest) 1))
(= (len rest) 1))
(let ((v (cssx-spacing-value (first rest))))
(if (nil? v) nil (str "gap:" v)))
;; ---------------------------------------------------------
;; Text decoration: underline, no-underline, line-through
;; ---------------------------------------------------------
(and (= (length parts) 1)
(and (= (len parts) 1)
(or (= head "underline") (= head "overline") (= head "line-through")))
(str "text-decoration-line:" head)
(and (= (length parts) 2) (= head "no") (= (first rest) "underline"))
(and (= (len parts) 2) (= head "no") (= (first rest) "underline"))
"text-decoration-line:none"
;; ---------------------------------------------------------
;; Cursor: cursor-pointer, cursor-default, etc.
;; ---------------------------------------------------------
(and (= head "cursor") (= (length rest) 1))
(and (= head "cursor") (= (len rest) 1))
(str "cursor:" (first rest))
;; ---------------------------------------------------------
;; Overflow: overflow-hidden, overflow-auto, etc.
;; ---------------------------------------------------------
(and (= head "overflow") (= (length rest) 1))
(and (= head "overflow") (= (len rest) 1))
(str "overflow:" (first rest))
;; ---------------------------------------------------------
@@ -381,7 +389,7 @@
(define cssx-process-token
(fn (token)
(let ((colon-parts (split token ":"))
(n (length colon-parts)))
(n (len colon-parts)))
;; Extract state, bp, and base utility from colon-separated parts
(let ((bp nil) (state nil) (base nil))
;; 1 part: just utility
@@ -439,80 +447,54 @@
(join "" parts))))
;; =========================================================================
;; ~cssx/tw — macro that injects JIT classes onto the first child element
;; ~cssx/tw — spread component that injects JIT classes onto parent element
;;
;; Usage:
;; (~cssx/tw "bg-yellow-199"
;; (p "sunny"))
;; Usage — as a child of any element:
;; (div (~cssx/tw "bg-yellow-199 text-violet-700 p-4 font-bold")
;; (h1 "styled content"))
;;
;; (~cssx/tw "bg-yellow-199 text-violet-700 p-4 font-bold rounded-lg"
;; (div (h1 "styled content")))
;; (button (~cssx/tw "hover:bg-rose-500 focus:border-blue-400")
;; "interactive")
;;
;; (~cssx/tw "hover:bg-rose-500 focus:border-blue-400"
;; (button "interactive"))
;; Returns a spread value that merges :class and :data-tw onto the parent
;; element. Collects CSS rules into the "cssx" bucket for a single global
;; <style> flush. No wrapper element, no per-element <style> tags.
;;
;; (~cssx/tw "md:text-xl lg:p-8"
;; (section "responsive"))
;; Reusable as variables:
;; (define important (~cssx/tw "font-bold text-4xl"))
;; (div important "the queen is dead")
;;
;; Parses tokens at macro-expansion time, injects :class onto the first
;; child element (merging with any existing :class), and prepends a
;; <style> tag with the JIT CSS rules. No wrapper element.
;; Multiple spreads merge naturally:
;; (div (~cssx/tw "bg-red-500") (~cssx/tw "p-4") "content")
;; =========================================================================
;; Merge :class into an element's arg list.
;; If element already has :class, prepend our classes to its value.
;; If not, inject :class after the tag name.
(define cssx-inject-class
(fn (element cls-str)
(let ((tag (first element))
(args (slice element 1)))
(cons tag (cssx-merge-class-args args cls-str false)))))
(defcomp ~cssx/tw (tokens)
(let ((token-list (filter (fn (t) (not (= t "")))
(split (or tokens "") " ")))
(results (map cssx-process-token token-list))
(valid (filter (fn (r) (not (nil? r))) results))
(classes (map (fn (r) (get r "cls")) valid))
(rules (map (fn (r) (get r "rule")) valid))
(_ (for-each (fn (rule) (collect! "cssx" rule)) rules)))
;; Return spread: injects class + data-tw onto parent element
(if (empty? classes)
nil
(make-spread {"class" (join " " classes)
"data-tw" (or tokens "")}))))
;; Walk arg list: find :class keyword, merge value. If not found, inject at end.
(define cssx-merge-class-args
(fn (args cls-str found)
(if (empty? args)
;; End of args — if no :class was found, inject one
(if found (list) (list :class cls-str))
(let ((head (first args))
(tail (slice args 1)))
(if (and (not found)
(= (type-of head) "keyword")
(= (keyword-name head) "class"))
;; Found :class — merge with next arg (the value)
(if (empty? tail)
;; :class with no value — replace with ours
(append (list :class cls-str) (list))
;; :class with value — prepend our classes
(append (list :class (str cls-str " " (first tail)))
(cssx-merge-class-args (slice tail 1) cls-str true)))
;; Not :class — keep and continue
(cons head (cssx-merge-class-args tail cls-str found)))))))
(defmacro ~cssx/tw (tokens &rest children)
(let ((token-list (filter (fn (t) (not (= t ""))) (split tokens " ")))
(classes (list))
(rules (list)))
;; Process each token
(for-each (fn (tok)
(let ((r (cssx-process-token tok)))
(when (not (nil? r))
(append! classes (get r "cls"))
(append! rules (get r "rule")))))
token-list)
(let ((cls-str (join " " classes))
(rules-str (join "" rules))
(first-child (first children))
(rest-children (slice children 1)))
(if (empty? classes)
;; No resolved tokens — pass through unchanged
(if (= (length children) 1) first-child `(<> ,@children))
;; Inject class onto first child element
(if (and (list? first-child) (not (empty? first-child)))
;; First child is an element — inject :class, prepend <style>
(let ((injected (cssx-inject-class first-child cls-str)))
(if (empty? rest-children)
`(<> (style ,rules-str) ,injected)
`(<> (style ,rules-str) ,injected ,@rest-children)))
;; First child isn't an element — wrap everything in div
`(<> (style ,rules-str) (div :class ,cls-str ,@children)))))))
;; =========================================================================
;; ~cssx/flush — emit collected CSS rules as a single <style> tag
;;
;; Place once in the page (typically in the layout, before </body>).
;; Emits all accumulated CSSX rules and clears the bucket.
;;
;; Usage:
;; (~cssx/flush)
;; =========================================================================
(defcomp ~cssx/flush ()
(let ((rules (collected "cssx")))
(clear-collected! "cssx")
(when (not (empty? rules))
(raw! (str "<style data-cssx>" (join "" rules) "</style>")))))