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

12
hosts/javascript/platform.py
View File

@@ -2047,8 +2047,10 @@ PLATFORM_DOM_JS = """
: function(e) { try { cekCall(handler, [e]); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } finally { runPostRenderHooks(); } }) : function(e) { try { cekCall(handler, [e]); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } finally { runPostRenderHooks(); } })
: handler; : handler;
if (name === "click") logInfo("domListen: click on <" + (el.tagName||"?").toLowerCase() + "> text=" + (el.textContent||"").substring(0,20) + " isLambda=" + isLambda(handler)); if (name === "click") logInfo("domListen: click on <" + (el.tagName||"?").toLowerCase() + "> text=" + (el.textContent||"").substring(0,20) + " isLambda=" + isLambda(handler));
el.addEventListener(name, wrapped); var passiveEvents = { touchstart: 1, touchmove: 1, wheel: 1, scroll: 1 };
return function() { el.removeEventListener(name, wrapped); }; var opts = passiveEvents[name] ? { passive: true } : undefined;
el.addEventListener(name, wrapped, opts);
return function() { el.removeEventListener(name, wrapped, opts); };
} }
function eventDetail(e) { function eventDetail(e) {
@@ -2670,6 +2672,7 @@ PLATFORM_ORCHESTRATION_JS = """
function preventDefault_(e) { if (e && e.preventDefault) e.preventDefault(); } function preventDefault_(e) { if (e && e.preventDefault) e.preventDefault(); }
function stopPropagation_(e) { if (e && e.stopPropagation) e.stopPropagation(); } function stopPropagation_(e) { if (e && e.stopPropagation) e.stopPropagation(); }
function eventModifierKey_p(e) { return !!(e && (e.ctrlKey || e.metaKey || e.shiftKey || e.altKey)); }
function domFocus(el) { if (el && el.focus) el.focus(); } function domFocus(el) { if (el && el.focus) el.focus(); }
function tryCatch(tryFn, catchFn) { function tryCatch(tryFn, catchFn) {
var t = _wrapSxFn(tryFn); var t = _wrapSxFn(tryFn);
@@ -2773,6 +2776,7 @@ PLATFORM_ORCHESTRATION_JS = """
function bindBoostLink(el, _href) { function bindBoostLink(el, _href) {
el.addEventListener("click", function(e) { el.addEventListener("click", function(e) {
if (e.ctrlKey || e.metaKey || e.shiftKey || e.altKey) return;
e.preventDefault(); e.preventDefault();
// Re-read href from element at click time (not closed-over value) // Re-read href from element at click time (not closed-over value)
var liveHref = el.getAttribute("href") || _href; var liveHref = el.getAttribute("href") || _href;
@@ -2804,6 +2808,7 @@ PLATFORM_ORCHESTRATION_JS = """
function bindClientRouteClick(link, _href, fallbackFn) { function bindClientRouteClick(link, _href, fallbackFn) {
link.addEventListener("click", function(e) { link.addEventListener("click", function(e) {
if (e.ctrlKey || e.metaKey || e.shiftKey || e.altKey) return;
e.preventDefault(); e.preventDefault();
// Re-read href from element at click time (not closed-over value) // Re-read href from element at click time (not closed-over value)
var liveHref = link.getAttribute("href") || _href; var liveHref = link.getAttribute("href") || _href;
@@ -2954,7 +2959,7 @@ PLATFORM_ORCHESTRATION_JS = """
} else { } else {
fn(); fn();
} }
}); }, { passive: true });
}); });
} }
@@ -3283,6 +3288,7 @@ def fixups_js(has_html, has_sx, has_dom, has_signals=False, has_deps=False, has_
if (typeof domClosest === "function") PRIMITIVES["dom-closest"] = domClosest; if (typeof domClosest === "function") PRIMITIVES["dom-closest"] = domClosest;
if (typeof domMatches === "function") PRIMITIVES["dom-matches?"] = domMatches; if (typeof domMatches === "function") PRIMITIVES["dom-matches?"] = domMatches;
if (typeof preventDefault_ === "function") PRIMITIVES["prevent-default"] = preventDefault_; if (typeof preventDefault_ === "function") PRIMITIVES["prevent-default"] = preventDefault_;
if (typeof eventModifierKey_p === "function") PRIMITIVES["event-modifier-key?"] = eventModifierKey_p;
if (typeof elementValue === "function") PRIMITIVES["element-value"] = elementValue; if (typeof elementValue === "function") PRIMITIVES["element-value"] = elementValue;
if (typeof domOuterHtml === "function") PRIMITIVES["dom-outer-html"] = domOuterHtml; if (typeof domOuterHtml === "function") PRIMITIVES["dom-outer-html"] = domOuterHtml;
if (typeof domInnerHtml === "function") PRIMITIVES["dom-inner-html"] = domInnerHtml; if (typeof domInnerHtml === "function") PRIMITIVES["dom-inner-html"] = domInnerHtml;

32
hosts/ocaml/bin/sx_server.ml
View File

@@ -125,11 +125,9 @@ let io_batch_mode = ref false
let io_queue : (int * string * value list) list ref = ref [] let io_queue : (int * string * value list) list ref = ref []
let io_counter = ref 0 let io_counter = ref 0
(** Module-level scope stacks — shared between make_server_env (aser (* Request cookies — set by Python bridge before each page render.
scope-push!/pop!) and step-sf-context (via get-primitive "scope-peek"). *) get-cookie reads from here on the server; set-cookie is a no-op
(** Request cookies — set by Python bridge before each page render. (server can't set response cookies from SX — that's the framework's job). *)
get-cookie reads from here on the server; set-cookie is a no-op
(server can't set response cookies from SX — that's the framework's job). *)
let _request_cookies : (string, string) Hashtbl.t = Hashtbl.create 8 let _request_cookies : (string, string) Hashtbl.t = Hashtbl.create 8
let () = Sx_primitives.register "get-cookie" (fun args -> let () = Sx_primitives.register "get-cookie" (fun args ->
@@ -144,6 +142,8 @@ let () = Sx_primitives.register "set-cookie" (fun _args ->
(* No-op on server — cookies are set via HTTP response headers *) (* No-op on server — cookies are set via HTTP response headers *)
Nil) Nil)
(* Module-level scope stacks — shared between make_server_env (aser
scope-push!/pop!) and step-sf-context (via get-primitive "scope-peek"). *)
let _scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8 let _scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8
let () = Sx_primitives.register "scope-push!" (fun args -> let () = Sx_primitives.register "scope-push!" (fun args ->
@@ -496,6 +496,10 @@ let make_server_env () =
bind "dom-text-content" (fun _args -> String ""); bind "dom-text-content" (fun _args -> String "");
bind "dom-set-text-content" (fun _args -> Nil); bind "dom-set-text-content" (fun _args -> Nil);
bind "dom-body" (fun _args -> Nil); bind "dom-body" (fun _args -> Nil);
bind "dom-create-element" (fun _args -> Nil);
bind "dom-append" (fun _args -> Nil);
bind "create-text-node" (fun _args -> Nil);
bind "render-to-dom" (fun _args -> Nil);
(* Raw HTML — platform primitives for adapter-html.sx *) (* Raw HTML — platform primitives for adapter-html.sx *)
bind "make-raw-html" (fun args -> bind "make-raw-html" (fun args ->
@@ -617,6 +621,16 @@ let make_server_env () =
Sx_ref.eval_expr m.m_body (Env body_env) Sx_ref.eval_expr m.m_body (Env body_env)
| _ -> raise (Eval_error "expand-macro: expected (macro args env)")); | _ -> raise (Eval_error "expand-macro: expected (macro args env)"));
(* Expose register-special-form! and *custom-special-forms* to SX code
(used by web-forms.sx and adapter form-classification functions) *)
bind "register-special-form!" (fun args ->
match args with
| [String name; handler] ->
ignore (Sx_ref.register_special_form (String name) handler);
Nil
| _ -> raise (Eval_error "register-special-form!: expected (name handler)"));
ignore (env_bind env "*custom-special-forms*" Sx_ref.custom_special_forms);
(* Register <> as a special form — evaluates all children, returns list *) (* Register <> as a special form — evaluates all children, returns list *)
ignore (Sx_ref.register_special_form (String "<>") (NativeFn ("<>", fun args -> ignore (Sx_ref.register_special_form (String "<>") (NativeFn ("<>", fun args ->
List (List.map (fun a -> Sx_ref.eval_expr a (Env env)) args)))); List (List.map (fun a -> Sx_ref.eval_expr a (Env env)) args))));
@@ -725,10 +739,8 @@ let make_server_env () =
bind "set-response-status" (fun args -> io_request "set-response-status" args); bind "set-response-status" (fun args -> io_request "set-response-status" args);
bind "set-response-header" (fun args -> io_request "set-response-header" args); bind "set-response-header" (fun args -> io_request "set-response-header" args);
(* Application constructs — no-ops in the kernel, but needed so (* defhandler/defpage/defquery/defaction/defrelation are registered by
handler/page files load successfully (their define forms get evaluated) *) web-forms.sx via register-special-form!, no longer hardcoded here. *)
ignore (Sx_ref.register_special_form (String "defhandler") (NativeFn ("defhandler", fun _args -> Nil)));
ignore (Sx_ref.register_special_form (String "defpage") (NativeFn ("defpage", fun _args -> Nil)));
bind "cond-scheme?" (fun args -> bind "cond-scheme?" (fun args ->
match args with match args with
@@ -1504,6 +1516,7 @@ let cli_mode mode =
Filename.concat base "render.sx"; Filename.concat base "render.sx";
Filename.concat web_base "adapter-html.sx"; Filename.concat web_base "adapter-html.sx";
Filename.concat web_base "adapter-sx.sx"; Filename.concat web_base "adapter-sx.sx";
Filename.concat web_base "web-forms.sx";
] in ] in
(* Load spec files for all CLI modes that need rendering *) (* Load spec files for all CLI modes that need rendering *)
(if mode = "aser" || mode = "aser-slot" || mode = "render" then (if mode = "aser" || mode = "aser-slot" || mode = "render" then
@@ -1588,6 +1601,7 @@ let test_mode () =
Filename.concat web_base "signals.sx"; Filename.concat web_base "signals.sx";
Filename.concat web_base "adapter-html.sx"; Filename.concat web_base "adapter-html.sx";
Filename.concat web_base "adapter-sx.sx"; Filename.concat web_base "adapter-sx.sx";
Filename.concat web_base "web-forms.sx";
] in ] in
cli_load_files env files; cli_load_files env files;
(* Register JIT *) (* Register JIT *)

28
shared/static/scripts/sx-browser.js
View File

@@ -14,7 +14,7 @@
// ========================================================================= // =========================================================================
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
var SX_VERSION = "2026-03-24T04:23:51Z"; var SX_VERSION = "2026-03-24T09:53:22Z";
function isNil(x) { return x === NIL || x === null || x === undefined; } function isNil(x) { return x === NIL || x === null || x === undefined; }
function isSxTruthy(x) { return x !== false && !isNil(x); } function isSxTruthy(x) { return x !== false && !isNil(x); }
@@ -2237,7 +2237,7 @@ PRIMITIVES["VOID_ELEMENTS"] = VOID_ELEMENTS;
PRIMITIVES["BOOLEAN_ATTRS"] = BOOLEAN_ATTRS; PRIMITIVES["BOOLEAN_ATTRS"] = BOOLEAN_ATTRS;
// definition-form? // definition-form?
var isDefinitionForm = function(name) { return sxOr((name == "define"), (name == "defcomp"), (name == "defisland"), (name == "defmacro"), (name == "defstyle"), (name == "defhandler"), (name == "deftype"), (name == "defeffect")); }; var isDefinitionForm = function(name) { return sxOr((name == "define"), (name == "defcomp"), (name == "defisland"), (name == "defmacro"), (name == "defstyle"), (name == "deftype"), (name == "defeffect")); };
PRIMITIVES["definition-form?"] = isDefinitionForm; PRIMITIVES["definition-form?"] = isDefinitionForm;
// parse-element-args // parse-element-args
@@ -2520,7 +2520,7 @@ PRIMITIVES["render-to-html"] = renderToHtml;
PRIMITIVES["render-value-to-html"] = renderValueToHtml; PRIMITIVES["render-value-to-html"] = renderValueToHtml;
// RENDER_HTML_FORMS // RENDER_HTML_FORMS
var RENDER_HTML_FORMS = ["if", "when", "cond", "case", "let", "let*", "letrec", "begin", "do", "define", "defcomp", "defisland", "defmacro", "defstyle", "defhandler", "deftype", "defeffect", "map", "map-indexed", "filter", "for-each", "scope", "provide"]; var RENDER_HTML_FORMS = ["if", "when", "cond", "case", "let", "let*", "letrec", "begin", "do", "define", "defcomp", "defisland", "defmacro", "defstyle", "deftype", "defeffect", "map", "map-indexed", "filter", "for-each", "scope", "provide"];
PRIMITIVES["RENDER_HTML_FORMS"] = RENDER_HTML_FORMS; PRIMITIVES["RENDER_HTML_FORMS"] = RENDER_HTML_FORMS;
// render-html-form? // render-html-form?
@@ -2533,10 +2533,10 @@ PRIMITIVES["render-html-form?"] = isRenderHtmlForm;
return (isSxTruthy(!isSxTruthy((typeOf(head) == "symbol"))) ? join("", map(function(x) { return renderValueToHtml(x, env); }, expr)) : (function() { return (isSxTruthy(!isSxTruthy((typeOf(head) == "symbol"))) ? join("", map(function(x) { return renderValueToHtml(x, env); }, expr)) : (function() {
var name = symbolName(head); var name = symbolName(head);
var args = rest(expr); var args = rest(expr);
return (isSxTruthy((name == "<>")) ? join("", map(function(x) { return renderToHtml(x, env); }, args)) : (isSxTruthy((name == "raw!")) ? join("", map(function(x) { return (String(trampoline(evalExpr(x, env)))); }, args)) : (isSxTruthy((name == "lake")) ? renderHtmlLake(args, env) : (isSxTruthy((name == "marsh")) ? renderHtmlMarsh(args, env) : (isSxTruthy(contains(HTML_TAGS, name)) ? renderHtmlElement(name, args, env) : (isSxTruthy((isSxTruthy(startsWith(name, "~")) && isSxTruthy(envHas(env, name)) && isIsland(envGet(env, name)))) ? renderHtmlIsland(envGet(env, name), args, env) : (isSxTruthy(startsWith(name, "~")) ? (function() { return (isSxTruthy((name == "<>")) ? join("", map(function(x) { return renderToHtml(x, env); }, args)) : (isSxTruthy((name == "raw!")) ? join("", map(function(x) { return (String(trampoline(evalExpr(x, env)))); }, args)) : (isSxTruthy((name == "lake")) ? renderHtmlLake(args, env) : (isSxTruthy((name == "marsh")) ? renderHtmlMarsh(args, env) : (isSxTruthy(sxOr((name == "portal"), (name == "error-boundary"), (name == "promise-delayed"))) ? join("", map(function(x) { return renderToHtml(x, env); }, args)) : (isSxTruthy(contains(HTML_TAGS, name)) ? renderHtmlElement(name, args, env) : (isSxTruthy((isSxTruthy(startsWith(name, "~")) && isSxTruthy(envHas(env, name)) && isIsland(envGet(env, name)))) ? renderHtmlIsland(envGet(env, name), args, env) : (isSxTruthy(startsWith(name, "~")) ? (function() {
var val = envGet(env, name); var val = envGet(env, name);
return (isSxTruthy(isComponent(val)) ? renderHtmlComponent(val, args, env) : (isSxTruthy(isMacro(val)) ? renderToHtml(expandMacro(val, args, env), env) : error((String("Unknown component: ") + String(name))))); return (isSxTruthy(isComponent(val)) ? renderHtmlComponent(val, args, env) : (isSxTruthy(isMacro(val)) ? renderToHtml(expandMacro(val, args, env), env) : error((String("Unknown component: ") + String(name)))));
})() : (isSxTruthy(isRenderHtmlForm(name)) ? dispatchHtmlForm(name, expr, env) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? renderToHtml(expandMacro(envGet(env, name), args, env), env) : renderValueToHtml(trampoline(evalExpr(expr, env)), env)))))))))); })() : (isSxTruthy(isRenderHtmlForm(name)) ? dispatchHtmlForm(name, expr, env) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? renderToHtml(expandMacro(envGet(env, name), args, env), env) : renderValueToHtml(trampoline(evalExpr(expr, env)), env)))))))))));
})()); })());
})()); }; })()); };
PRIMITIVES["render-list-to-html"] = renderListToHtml; PRIMITIVES["render-list-to-html"] = renderListToHtml;
@@ -3110,7 +3110,7 @@ PRIMITIVES["render-dom-raw"] = renderDomRaw;
PRIMITIVES["render-dom-unknown-component"] = renderDomUnknownComponent; PRIMITIVES["render-dom-unknown-component"] = renderDomUnknownComponent;
// RENDER_DOM_FORMS // RENDER_DOM_FORMS
var RENDER_DOM_FORMS = ["if", "when", "cond", "case", "let", "let*", "begin", "do", "define", "defcomp", "defisland", "defmacro", "defstyle", "defhandler", "map", "map-indexed", "filter", "for-each", "portal", "error-boundary", "scope", "provide"]; var RENDER_DOM_FORMS = ["if", "when", "cond", "case", "let", "let*", "begin", "do", "define", "defcomp", "defisland", "defmacro", "defstyle", "map", "map-indexed", "filter", "for-each", "portal", "error-boundary", "scope", "provide"];
PRIMITIVES["RENDER_DOM_FORMS"] = RENDER_DOM_FORMS; PRIMITIVES["RENDER_DOM_FORMS"] = RENDER_DOM_FORMS;
// render-dom-form? // render-dom-form?
@@ -4181,7 +4181,7 @@ PRIMITIVES["bind-triggers"] = bindTriggers;
return (isSxTruthy((val == lastVal)) ? (shouldFire = false) : (lastVal = val)); return (isSxTruthy((val == lastVal)) ? (shouldFire = false) : (lastVal = val));
})(); })();
} }
return (isSxTruthy(shouldFire) ? ((isSxTruthy(sxOr((eventName == "submit"), (isSxTruthy((eventName == "click")) && domHasAttr(el, "href")))) ? preventDefault_(e) : NIL), (function() { return (isSxTruthy(shouldFire) ? ((isSxTruthy((isSxTruthy((eventName == "click")) && eventModifierKey_p(e))) ? (shouldFire = false) : NIL), (isSxTruthy(shouldFire) ? ((isSxTruthy(sxOr((eventName == "submit"), (isSxTruthy((eventName == "click")) && domHasAttr(el, "href")))) ? preventDefault_(e) : NIL), (function() {
var liveInfo = sxOr(getVerbInfo(el), verbInfo); var liveInfo = sxOr(getVerbInfo(el), verbInfo);
var isGetLink = (isSxTruthy((eventName == "click")) && isSxTruthy((get(liveInfo, "method") == "GET")) && isSxTruthy(domHasAttr(el, "href")) && !isSxTruthy(get(mods, "delay"))); var isGetLink = (isSxTruthy((eventName == "click")) && isSxTruthy((get(liveInfo, "method") == "GET")) && isSxTruthy(domHasAttr(el, "href")) && !isSxTruthy(get(mods, "delay")));
var clientRouted = false; var clientRouted = false;
@@ -4189,7 +4189,7 @@ PRIMITIVES["bind-triggers"] = bindTriggers;
clientRouted = tryClientRoute(urlPathname(get(liveInfo, "url")), domGetAttr(el, "sx-target")); clientRouted = tryClientRoute(urlPathname(get(liveInfo, "url")), domGetAttr(el, "sx-target"));
} }
return (isSxTruthy(clientRouted) ? (browserPushState(get(liveInfo, "url")), browserScrollTo(0, 0)) : ((isSxTruthy(isGetLink) ? logInfo((String("sx:route server fetch ") + String(get(liveInfo, "url")))) : NIL), (isSxTruthy(get(mods, "delay")) ? (clearTimeout_(timer), (timer = setTimeout_(function() { return executeRequest(el, NIL, NIL); }, get(mods, "delay")))) : executeRequest(el, NIL, NIL)))); return (isSxTruthy(clientRouted) ? (browserPushState(get(liveInfo, "url")), browserScrollTo(0, 0)) : ((isSxTruthy(isGetLink) ? logInfo((String("sx:route server fetch ") + String(get(liveInfo, "url")))) : NIL), (isSxTruthy(get(mods, "delay")) ? (clearTimeout_(timer), (timer = setTimeout_(function() { return executeRequest(el, NIL, NIL); }, get(mods, "delay")))) : executeRequest(el, NIL, NIL))));
})()) : NIL); })()) : NIL)) : NIL);
})(); }, (isSxTruthy(get(mods, "once")) ? {["once"]: true} : NIL)) : NIL); })(); }, (isSxTruthy(get(mods, "once")) ? {["once"]: true} : NIL)) : NIL);
})(); }; })(); };
PRIMITIVES["bind-event"] = bindEvent; PRIMITIVES["bind-event"] = bindEvent;
@@ -5880,6 +5880,7 @@ PRIMITIVES["resource"] = resource;
if (typeof domClosest === "function") PRIMITIVES["dom-closest"] = domClosest; if (typeof domClosest === "function") PRIMITIVES["dom-closest"] = domClosest;
if (typeof domMatches === "function") PRIMITIVES["dom-matches?"] = domMatches; if (typeof domMatches === "function") PRIMITIVES["dom-matches?"] = domMatches;
if (typeof preventDefault_ === "function") PRIMITIVES["prevent-default"] = preventDefault_; if (typeof preventDefault_ === "function") PRIMITIVES["prevent-default"] = preventDefault_;
if (typeof eventModifierKey_p === "function") PRIMITIVES["event-modifier-key?"] = eventModifierKey_p;
if (typeof elementValue === "function") PRIMITIVES["element-value"] = elementValue; if (typeof elementValue === "function") PRIMITIVES["element-value"] = elementValue;
if (typeof domOuterHtml === "function") PRIMITIVES["dom-outer-html"] = domOuterHtml; if (typeof domOuterHtml === "function") PRIMITIVES["dom-outer-html"] = domOuterHtml;
if (typeof domInnerHtml === "function") PRIMITIVES["dom-inner-html"] = domInnerHtml; if (typeof domInnerHtml === "function") PRIMITIVES["dom-inner-html"] = domInnerHtml;
@@ -6183,8 +6184,10 @@ PRIMITIVES["resource"] = resource;
: function(e) { try { cekCall(handler, [e]); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } finally { runPostRenderHooks(); } }) : function(e) { try { cekCall(handler, [e]); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } finally { runPostRenderHooks(); } })
: handler; : handler;
if (name === "click") logInfo("domListen: click on <" + (el.tagName||"?").toLowerCase() + "> text=" + (el.textContent||"").substring(0,20) + " isLambda=" + isLambda(handler)); if (name === "click") logInfo("domListen: click on <" + (el.tagName||"?").toLowerCase() + "> text=" + (el.textContent||"").substring(0,20) + " isLambda=" + isLambda(handler));
el.addEventListener(name, wrapped); var passiveEvents = { touchstart: 1, touchmove: 1, wheel: 1, scroll: 1 };
return function() { el.removeEventListener(name, wrapped); }; var opts = passiveEvents[name] ? { passive: true } : undefined;
el.addEventListener(name, wrapped, opts);
return function() { el.removeEventListener(name, wrapped, opts); };
} }
function eventDetail(e) { function eventDetail(e) {
@@ -6802,6 +6805,7 @@ PRIMITIVES["resource"] = resource;
function preventDefault_(e) { if (e && e.preventDefault) e.preventDefault(); } function preventDefault_(e) { if (e && e.preventDefault) e.preventDefault(); }
function stopPropagation_(e) { if (e && e.stopPropagation) e.stopPropagation(); } function stopPropagation_(e) { if (e && e.stopPropagation) e.stopPropagation(); }
function eventModifierKey_p(e) { return !!(e && (e.ctrlKey || e.metaKey || e.shiftKey || e.altKey)); }
function domFocus(el) { if (el && el.focus) el.focus(); } function domFocus(el) { if (el && el.focus) el.focus(); }
function tryCatch(tryFn, catchFn) { function tryCatch(tryFn, catchFn) {
var t = _wrapSxFn(tryFn); var t = _wrapSxFn(tryFn);
@@ -6905,6 +6909,7 @@ PRIMITIVES["resource"] = resource;
function bindBoostLink(el, _href) { function bindBoostLink(el, _href) {
el.addEventListener("click", function(e) { el.addEventListener("click", function(e) {
if (e.ctrlKey || e.metaKey || e.shiftKey || e.altKey) return;
e.preventDefault(); e.preventDefault();
// Re-read href from element at click time (not closed-over value) // Re-read href from element at click time (not closed-over value)
var liveHref = el.getAttribute("href") || _href; var liveHref = el.getAttribute("href") || _href;
@@ -6936,6 +6941,7 @@ PRIMITIVES["resource"] = resource;
function bindClientRouteClick(link, _href, fallbackFn) { function bindClientRouteClick(link, _href, fallbackFn) {
link.addEventListener("click", function(e) { link.addEventListener("click", function(e) {
if (e.ctrlKey || e.metaKey || e.shiftKey || e.altKey) return;
e.preventDefault(); e.preventDefault();
// Re-read href from element at click time (not closed-over value) // Re-read href from element at click time (not closed-over value)
var liveHref = link.getAttribute("href") || _href; var liveHref = link.getAttribute("href") || _href;
@@ -7086,7 +7092,7 @@ PRIMITIVES["resource"] = resource;
} else { } else {
fn(); fn();
} }
}); }, { passive: true });
}); });
} }

5
shared/sx/ocaml_bridge.py
View File

@@ -420,10 +420,11 @@ class OcamlBridge:
# All directories loaded into the Python env # All directories loaded into the Python env
all_dirs = list(set(_watched_dirs) | _dirs_from_cache) all_dirs = list(set(_watched_dirs) | _dirs_from_cache)
# Isomorphic libraries: signals, rendering, freeze scopes # Isomorphic libraries: signals, rendering, freeze scopes, web forms
web_dir = os.path.join(os.path.dirname(__file__), "../../web") web_dir = os.path.join(os.path.dirname(__file__), "../../web")
if os.path.isdir(web_dir): if os.path.isdir(web_dir):
for web_file in ["signals.sx", "adapter-html.sx", "adapter-sx.sx"]: for web_file in ["signals.sx", "adapter-html.sx", "adapter-sx.sx",
"web-forms.sx"]:
path = os.path.normpath(os.path.join(web_dir, web_file)) path = os.path.normpath(os.path.join(web_dir, web_file))
if os.path.isfile(path): if os.path.isfile(path):
all_files.append(path) all_files.append(path)

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

@@ -494,16 +494,13 @@
;; ========================================================================= ;; =========================================================================
(defcomp ~cssx/flush () :affinity :client (defcomp ~cssx/flush () :affinity :client
(let ((rules (collected "cssx"))) (let ((rules (collected "cssx"))
(clear-collected! "cssx") (head-style (dom-query "#sx-css")))
(when (not (empty? rules)) ;; On client: append rules to <style id="sx-css"> in <head>.
;; Append to the persistent <style id="sx-css"> in <head> if available. ;; On server: head-style is nil (no DOM). Don't clear the bucket —
;; This survives #main-panel morphs during SPA navigation. ;; the shell's <head> template reads collected("cssx") and emits them.
;; Falls back to inline <style> if no head stylesheet exists. (when head-style
(let ((head-style (dom-query "#sx-css"))) (clear-collected! "cssx")
(if head-style (when (not (empty? rules))
(do (dom-set-prop head-style "textContent"
(dom-set-prop head-style "textContent" (str (dom-get-prop head-style "textContent") (join "" rules)))))))
(str (dom-get-prop head-style "textContent") (join "" rules)))
nil)
(raw! (str "<style data-cssx>" (join "" rules) "</style>")))))))

2
spec/render.sx
View File

@@ -74,7 +74,7 @@
(define definition-form? :effects [] (define definition-form? :effects []
(fn ((name :as string)) (fn ((name :as string))
(or (= name "define") (= name "defcomp") (= name "defisland") (or (= name "define") (= name "defcomp") (= name "defisland")
(= name "defmacro") (= name "defstyle") (= name "defhandler") (= name "defmacro") (= name "defstyle")
(= name "deftype") (= name "defeffect")))) (= name "deftype") (= name "defeffect"))))

8
web/adapter-async.sx
View File

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

2
web/adapter-dom.sx
View File

@@ -379,7 +379,7 @@
(define RENDER_DOM_FORMS (define RENDER_DOM_FORMS
(list "if" "when" "cond" "case" "let" "let*" "begin" "do" (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" "map" "map-indexed" "filter" "for-each" "portal"
"error-boundary" "scope" "provide")) "error-boundary" "scope" "provide"))

7
web/adapter-html.sx
View File

@@ -57,7 +57,7 @@
(define RENDER_HTML_FORMS (define RENDER_HTML_FORMS
(list "if" "when" "cond" "case" "let" "let*" "letrec" "begin" "do" (list "if" "when" "cond" "case" "let" "let*" "letrec" "begin" "do"
"define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler" "define" "defcomp" "defisland" "defmacro" "defstyle"
"deftype" "defeffect" "deftype" "defeffect"
"map" "map-indexed" "filter" "for-each" "scope" "provide")) "map" "map-indexed" "filter" "for-each" "scope" "provide"))
@@ -97,6 +97,11 @@
(= name "marsh") (= name "marsh")
(render-html-marsh args env) (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 ;; HTML tag
(contains? HTML_TAGS name) (contains? HTML_TAGS name)
(render-html-element name args env) (render-html-element name args env)

7
web/orchestration.sx
View File

@@ -416,6 +416,11 @@
(set! last-val val)))) (set! last-val val))))
(when should-fire (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 ;; Prevent default for submit/click on links
(when (or (= event-name "submit") (when (or (= event-name "submit")
(and (= event-name "click") (and (= event-name "click")
@@ -448,7 +453,7 @@
(set-timeout (set-timeout
(fn () (execute-request el nil nil)) (fn () (execute-request el nil nil))
(get mods "delay")))) (get mods "delay"))))
(execute-request el nil nil)))))))) (execute-request el nil nil)))))))))
(if (get mods "once") (dict "once" true) 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)