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

Web extension module for def-forms + modifier-key clicks + CSSX SSR fix

Browse Source 
Move defhandler/defquery/defaction/defpage/defrelation from hardcoded
evaluator dispatch to web/web-forms.sx extension module, registered via
register-special-form!. Adapters updated to use definition-form? and
dynamically extended form-name lists.

Fix modifier-key clicks (ctrl-click → new tab) in three click handlers:
bindBoostLink, bindClientRouteClick, and orchestration.sx bind-event.
Add event-modifier-key? primitive (eventModifierKey_p for transpiler).

Fix CSSX SSR: ~cssx/flush no longer drains the collected bucket on the
server, so the shell template correctly emits CSSX rules in <head>.

Add missing server-side DOM stubs (create-text-node, dom-append, etc.)
and SSR passthrough for portal/error-boundary/promise-delayed.

Passive event listeners for touch/wheel/scroll to fix touchpad scrolling.

97/97 Playwright demo tests + 4/4 isomorphic SSR tests pass.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-24 10:01:41 +00:00
parent 8ccf5f7c1e
commit 8a08de26cd
11 changed files with 318 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
web/adapter-async.sx
View File

@@ -333,7 +333,7 @@
(define ASYNC_RENDER_FORMS
(list "if" "when" "cond" "case" "let" "let*" "begin" "do"
"define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler"
"define" "defcomp" "defisland" "defmacro" "defstyle"
"deftype" "defeffect"
"map" "map-indexed" "filter" "for-each" "scope" "provide"))
@@ -924,7 +924,6 @@
(list "if" "when" "cond" "case" "and" "or"
"let" "let*" "lambda" "fn"
"define" "defcomp" "defmacro" "defstyle"
"defhandler" "defpage" "defquery" "defaction"
"begin" "do" "quote" "->" "set!" "defisland"
"deftype" "defeffect" "scope" "provide"))
@@ -1058,10 +1057,7 @@
(serialize expr))
;; Definition forms — evaluate for side effects
(or (= name "define") (= name "defcomp") (= name "defmacro")
(= name "defstyle") (= name "defhandler") (= name "defpage")
(= name "defquery") (= name "defaction")
(= name "deftype") (= name "defeffect"))
(definition-form? name)
(do (async-eval expr env ctx) nil)
;; scope — unified render-time dynamic scope

2
web/adapter-dom.sx
View File

@@ -379,7 +379,7 @@
(define RENDER_DOM_FORMS
(list "if" "when" "cond" "case" "let" "let*" "begin" "do"
"define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler"
"define" "defcomp" "defisland" "defmacro" "defstyle"
"map" "map-indexed" "filter" "for-each" "portal"
"error-boundary" "scope" "provide"))

7
web/adapter-html.sx
View File

@@ -57,7 +57,7 @@
(define RENDER_HTML_FORMS
(list "if" "when" "cond" "case" "let" "let*" "letrec" "begin" "do"
"define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler"
"define" "defcomp" "defisland" "defmacro" "defstyle"
"deftype" "defeffect"
"map" "map-indexed" "filter" "for-each" "scope" "provide"))
@@ -97,6 +97,11 @@
(= name "marsh")
(render-html-marsh args env)
;; Client-only wrappers — render children, skip wrapper
(or (= name "portal") (= name "error-boundary")
(= name "promise-delayed"))
(join "" (map (fn (x) (render-to-html x env)) args))
;; HTML tag
(contains? HTML_TAGS name)
(render-html-element name args env)

7
web/orchestration.sx
View File

@@ -416,6 +416,11 @@
(set! last-val val))))
(when should-fire
;; Let browser handle modifier-key clicks (ctrl-click → new tab)
(when (and (= event-name "click") (event-modifier-key? e))
(set! should-fire false))
(when should-fire
;; Prevent default for submit/click on links
(when (or (= event-name "submit")
(and (= event-name "click")
@@ -448,7 +453,7 @@
(set-timeout
(fn () (execute-request el nil nil))
(get mods "delay"))))
(execute-request el nil nil))))))))
(execute-request el nil nil)))))))))
(if (get mods "once") (dict "once" true) nil))))))

240
web/web-forms.sx Normal file
View File

@@ -0,0 +1,240 @@
;; ==========================================================================
;; web-forms.sx — Web-specific definition forms
;;
;; Registers defhandler, defquery, defaction, defpage, and defrelation as
;; custom special forms via register-special-form!. These are web platform
;; constructs, not core language features — loaded as an extension module
;; rather than being hardcoded in the evaluator.
;;
;; Each form parses its domain-specific argument structure and stores
;; a definition dict in the environment with a namespaced key:
;; handler:name, query:name, action:name, page:name, relation:name
;;
;; Platform hosts provide typed constructors (make-handler-def etc.) that
;; return host-appropriate values. If unavailable, plain dicts are used.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Shared helpers
;; --------------------------------------------------------------------------
(define parse-key-params
(fn (params-expr)
;; Parse (&key param1 param2 ...) → list of param name strings.
;; Skips &key marker, collects symbol names.
(let ((params (list)))
(for-each
(fn (p)
(when (= (type-of p) "symbol")
(let ((name (symbol-name p)))
(when (not (= name "&key"))
(append! params name)))))
params-expr)
params)))
(define parse-handler-args
(fn (args)
;; Parse defhandler args after the name symbol.
;; Scans for :keyword value option pairs, then a list (params), then body.
;; Returns dict with keys: opts, params, body.
(let ((opts (dict))
(params (list))
(body nil)
(i 0)
(n (len args))
(done false))
(for-each
(fn (idx)
(when (and (not done) (= idx i))
(let ((arg (nth args idx)))
(cond
(= (type-of arg) "keyword")
(do
(when (< (+ idx 1) n)
(let ((val (nth args (+ idx 1))))
(dict-set! opts (keyword-name arg)
(if (= (type-of val) "keyword")
(keyword-name val)
val))))
(set! i (+ idx 2)))
(= (type-of arg) "list")
(do
(set! params (parse-key-params arg))
(when (< (+ idx 1) n)
(set! body (nth args (+ idx 1))))
(set! done true))
:else
(do
(set! body arg)
(set! done true))))))
(range 0 n))
(dict "opts" opts "params" params "body" body))))
;; --------------------------------------------------------------------------
;; defhandler — Event handler / HTTP endpoint definition
;; --------------------------------------------------------------------------
(register-special-form! "defhandler"
(fn (args env)
(let ((name-sym (first args))
(name (symbol-name (first args)))
(parsed (parse-handler-args (rest args)))
(opts (get parsed "opts"))
(params (get parsed "params"))
(body (get parsed "body")))
(let ((hdef (dict
"__type" "handler"
"name" name
"params" params
"body" body
"closure" env
"path" (or (get opts "path") nil)
"method" (or (get opts "method") "get")
"csrf" (let ((v (get opts "csrf")))
(if (nil? v) true v))
"returns" (or (get opts "returns") "element"))))
(env-bind! env (str "handler:" name) hdef)
hdef))))
;; --------------------------------------------------------------------------
;; defquery — Named query for data fetching
;; --------------------------------------------------------------------------
(register-special-form! "defquery"
(fn (args env)
(let ((name (symbol-name (first args)))
(params-raw (nth args 1))
(params (parse-key-params params-raw))
(has-doc (and (>= (len args) 4)
(= (type-of (nth args 2)) "string")))
(doc (if has-doc (nth args 2) ""))
(body (if has-doc (nth args 3) (nth args 2))))
(let ((qdef (dict
"__type" "query"
"name" name
"params" params
"doc" doc
"body" body
"closure" env)))
(env-bind! env (str "query:" name) qdef)
qdef))))
;; --------------------------------------------------------------------------
;; defaction — Named action for mutations
;; --------------------------------------------------------------------------
(register-special-form! "defaction"
(fn (args env)
(let ((name (symbol-name (first args)))
(params-raw (nth args 1))
(params (parse-key-params params-raw))
(has-doc (and (>= (len args) 4)
(= (type-of (nth args 2)) "string")))
(doc (if has-doc (nth args 2) ""))
(body (if has-doc (nth args 3) (nth args 2))))
(let ((adef (dict
"__type" "action"
"name" name
"params" params
"doc" doc
"body" body
"closure" env)))
(env-bind! env (str "action:" name) adef)
adef))))
;; --------------------------------------------------------------------------
;; defpage — Page route definition
;; --------------------------------------------------------------------------
(register-special-form! "defpage"
(fn (args env)
(let ((name (symbol-name (first args)))
(slots (dict))
(n (len args)))
;; Parse :key value pairs after the name
(for-each
(fn (idx)
(let ((k-idx (+ 1 (* idx 2)))
(v-idx (+ 2 (* idx 2))))
(when (and (< k-idx n) (< v-idx n)
(= (type-of (nth args k-idx)) "keyword"))
(dict-set! slots (keyword-name (nth args k-idx))
(nth args v-idx)))))
(range 0 (/ (- n 1) 2)))
(let ((pdef (dict
"__type" "page"
"name" name
"path" (or (get slots "path") "")
"auth" (or (get slots "auth") "public")
"layout" (get slots "layout")
"data" (get slots "data")
"content" (get slots "content")
"filter" (get slots "filter")
"aside" (get slots "aside")
"menu" (get slots "menu")
"stream" (get slots "stream")
"fallback" (get slots "fallback")
"shell" (get slots "shell")
"closure" env)))
(env-bind! env (str "page:" name) pdef)
pdef))))
;; --------------------------------------------------------------------------
;; defrelation — Relationship definition (cross-domain)
;; --------------------------------------------------------------------------
(register-special-form! "defrelation"
(fn (args env)
(let ((name (symbol-name (first args)))
(slots (dict))
(n (len args)))
(for-each
(fn (idx)
(let ((k-idx (+ 1 (* idx 2)))
(v-idx (+ 2 (* idx 2))))
(when (and (< k-idx n) (< v-idx n)
(= (type-of (nth args k-idx)) "keyword"))
(dict-set! slots (keyword-name (nth args k-idx))
(nth args v-idx)))))
(range 0 (/ (- n 1) 2)))
(let ((rdef (dict
"__type" "relation"
"name" name
"slots" slots
"closure" env)))
(env-bind! env (str "relation:" name) rdef)
rdef))))
;; --------------------------------------------------------------------------
;; Patch form-classification functions
;;
;; The adapters (html, sx, dom, async) use classifier functions to decide
;; how to handle forms during rendering. Now that these web forms are
;; registered as custom special forms, we redefine the classifiers to
;; include them. This runs after all adapters are loaded.
;; --------------------------------------------------------------------------
(define WEB_FORM_NAMES
(list "defhandler" "defpage" "defquery" "defaction" "defrelation"))
;; Redefine definition-form? to include web forms.
;; All adapters call this to identify "eval for side effects" forms.
(let ((core-definition-form? definition-form?))
(define definition-form?
(fn (name)
(or (core-definition-form? name)
(contains? WEB_FORM_NAMES name)))))
;; Extend adapter form-name lists so dispatchers recognise web forms.
;; These lists are mutable — append! adds to them in place.
(for-each (fn (name)
(append! RENDER_HTML_FORMS name)
(append! SPECIAL_FORM_NAMES name))
WEB_FORM_NAMES)